home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / pascal / o_gem / units / owindows.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-09-22  |  357.9 KB  |  15,043 lines
  1. {**************************************
  2.  *  O b j e c t G E M   Version 1.17  *
  3.  *  Copyright 1992-94 by Thomas Much  *
  4.  **************************************
  5.  *       Unit  O W I N D O W S        *
  6.  **************************************
  7.  *    Softdesign Computer Software    *
  8.  *    Thomas Much, Gerwigstraße 46,   *
  9.  *  76131 Karlsruhe, (0721) 62 28 41  *
  10.  *         Thomas Much @ KA2          *
  11.  *  UK48@ibm3090.rz.uni-karlsruhe.de  *
  12.  **************************************
  13.  *    erstellt am:        13.07.1992  *
  14.  *    letztes Update am:  12.09.1994  *
  15.  **************************************}
  16.  
  17. {
  18.   WICHTIGE ANMERKUNGEN ZUM QUELLTEXT:
  19.  
  20.   ObjectGEM wird mit dem _vollständigen_ Quelltext ausgeliefert, d.h.
  21.   jeder kann sich die Unit selbst compilieren, womit die extrem lästigen
  22.   Kompatibilitätsprobleme mit den PP-Releases beseitigt sind.
  23.   ObjectGEM ist und bleibt aber trotzdem SHAREWARE, d.h. wer die Biblio-
  24.   thek regelmäßig benutzt, muß sich REGISTRIEREN lassen. Dafür gibt es
  25.   die neueste Version und - gegen einen geringen Aufpreis - auch ein
  26.   gedrucktes Handbuch.
  27.  
  28.   WICHTIG: Wer den Quelltext verändert und dann Probleme beim Compilieren,
  29.   Ausführen o.ä. hat, kann nicht damit rechnen, daß ich den Fehler suche;
  30.   tritt der Fehler allerdings auch mit dem Original-Quelltext auf, würde
  31.   ich mich über eine genaue Fehlerbeschreibung freuen. Veränderte Quell-
  32.   texte dürfen _nicht_ weitergegeben werden, dies wäre ein Verstoß gegen
  33.   das Copyright!
  34.  
  35.   Wer beim Durchstöbern des Textes auf vermeintliche Fehler oder verbesse-
  36.   rungswürdige Stellen trifft (von letzterem gibt es sicherlich noch viele),
  37.   kann mir dies gerne mitteilen - ich habe auch ich nichts gegen kostenlos
  38.   zur Verfügung gestellte optimierte Routinen (sofern sich jemand die Mühe
  39.   macht). Wer in anderen Projekten, die nicht in direkter Konkurrenz zu
  40.   ObjectGEM stehen, einzelne Routinen verwenden möchte, wendet sich bitte
  41.   an mich (ein solcher Austausch sollte kein Problem sein).
  42.  
  43.   Wer sich auf nicht dokumentierte "implementation"- oder "private"-Eigen-
  44.   schaften verläßt, darf sich nicht über Inkompatibilitäten zu späteren
  45.   Versionen wundern; wer meint, eine Dokumentationslücke entdeckt zu haben,
  46.   kann mir dies gerne mitteilen.
  47.  
  48.   Kleine Info zum Schluß: Als "default tabsize" verwende ich 2. Wer drei
  49.   Punkte ("...") im Quelltext entdeckt, hat eine Stelle gefunden, an der
  50.   ich z.Z. arbeite ;-)
  51.  
  52.   "Möge die OOP mit Euch sein!"
  53. }
  54.  
  55.  
  56. {$IFDEF DEBUG}
  57.     {$B+,D+,G-,I-,L+,N-,P-,Q+,R+,S+,T-,V-,X+,Z+}
  58. {$ELSE}
  59.     {$B+,D-,G-,I-,L-,N-,P-,Q-,R-,S-,T-,V-,X+,Z+}
  60. {$ENDIF}
  61.  
  62. unit OWindows;
  63.  
  64. interface
  65.  
  66. uses
  67.  
  68.     Tos,Gem,Objects,OTypes,OProcs;
  69.  
  70. const
  71.  
  72.     S_Esc        = gem.Esc;
  73.     S_Undo       = gem.Undo;
  74.     S_Help       = gem.Help;
  75.  
  76. type
  77.  
  78.     PEvent       = ^TEvent;
  79.     PWindow      = ^TWindow;
  80.     PDialog      = ^TDialog;
  81.     PKeyMenu     = ^TKeyMenu;
  82.  
  83.     PEventObject = ^TEventObject;
  84.     TEventObject = object(TObject)
  85.         public
  86.         EventList: PEvent;
  87.         constructor Init;
  88.         destructor Done; virtual;
  89.     end;
  90.  
  91.     TEvent       = object(TObject)
  92.         public
  93.         Parent: PEventObject;
  94.         Style : word;
  95.         constructor Init(AParent: PEventObject);
  96.         destructor Done; virtual;
  97.         function TestKey(Stat,Key: integer): boolean; virtual;
  98.         function TestButton(mX,mY,BStat,KStat,Clicks: integer): boolean; virtual;
  99.         function TestMouse(M,mX,mY,BStat,KStat: integer): boolean; virtual;
  100.         function TestMessage(Pipe: Pipearray): boolean; virtual;
  101.         function TestMenu(mNum: integer): boolean; virtual;
  102.         procedure Work; virtual;
  103.         function Previous: PEvent;
  104.         function Next: PEvent;
  105.         private
  106.         Prev,
  107.         Nxt : PEvent
  108.     end;
  109.  
  110.     PValidator   = ^TValidator;
  111.     TValidator   = object(TObject)
  112.         public
  113.         Status,
  114.         Options: Word;
  115.         Window : PDialog;
  116.         constructor Init;
  117.         procedure Error; virtual;
  118.         function IsValid(s: string): boolean; virtual;
  119.         function IsValidInput(var s: string; SuppressFill: boolean): boolean; virtual;
  120.         function Valid(s: string): boolean; virtual;
  121.     end;
  122.  
  123.     PIcon = ^TIcon;
  124.     TIcon = object(TEvent)
  125.         public
  126.         XPos,
  127.         YPos,
  128.         Click,
  129.         Shift,
  130.         VStat,
  131.         VKey   : integer;
  132.         ADialog: PDialog;
  133.         constructor Init(AParent: PEventObject; ATree,AnIndex,iX,iY: integer; Movable,Selectble: boolean; AName,Hlp: string);
  134.         destructor Done; virtual;
  135.         function TestButton(mX,mY,BStat,KStat,Clicks: integer): boolean; virtual;
  136.         function TestKey(Stat,Key: integer): boolean; virtual;
  137.         function GetOutline(var IcnRect,TxtRect: GRECT): boolean; virtual;
  138.         function IsSelected(r: GRECT): boolean; virtual;
  139.         procedure SetText(AName: string); virtual;
  140.         function GetText: string; virtual;
  141.         procedure SetPos(iX,iY: integer; Redraw: boolean); virtual;
  142.         procedure SetCheck(CheckFlag: integer); virtual;
  143.         function GetCheck: integer; virtual;
  144.         procedure Check; virtual;
  145.         procedure Uncheck; virtual;
  146.         procedure Toggle; virtual;
  147.         procedure Hide(Draw: boolean); virtual;
  148.         procedure Unhide; virtual;
  149.         function IsHidden: boolean; virtual;
  150.         procedure Paint; virtual;
  151.         function IsHelpAvailable: boolean; virtual;
  152.         function GetHelp: string; virtual;
  153.         procedure SetHelp(Hlp: string); virtual;
  154.         procedure IMMoved(X,Y: integer); virtual;
  155.         private
  156.         icontext,
  157.         BHelp       : PString;
  158.         IsMovable,
  159.         IsSelectable,
  160.         rubsel,
  161.         hideflag    : boolean;
  162.         txrel,
  163.         tyrel,
  164.         ObjTree,
  165.         ObjIndx     : integer;
  166.         ObjAddr     : PObj;
  167.         VObj        : AESObject;
  168.         procedure RedrawParent;
  169.     end;
  170.  
  171.     PClipboard = ^TClipboard;
  172.     TClipboard = object (TObject)
  173.         public
  174.         Parent: PObject;
  175.         constructor Init(AParent: PObject);
  176.         function OpenClipboard(Write: boolean): boolean; virtual;
  177.         function IsOpen: boolean; virtual;
  178.         function GetClipboardFilename: string; virtual;
  179.         function GetPriorityClipboardFormat(PriorityList: string): string; virtual;
  180.         function IsClipboardFormatAvailable(Format: string): boolean; virtual;
  181.         function EmptyClipboard: boolean; virtual;
  182.         procedure SetClipboardFormat(Mask: word; Ext: string); virtual;
  183.         function CloseClipboard: boolean; virtual;
  184.         private
  185.         openflag,
  186.         writeflag: boolean;
  187.         clippath,
  188.         formats  : PString;
  189.         clipext  : string[4];
  190.         clipmask : word
  191.     end;
  192.  
  193.     PControl     = ^TControl;
  194.     TControl     = object(TObject)
  195.         public
  196.         Parent : PDialog;
  197.         Style  : word;
  198.         Flags  : byte;
  199.         ObjIndx,
  200.         ID     : integer;
  201.         ObjAddr: PObj;
  202.         UsrDef : boolean;
  203.         UsrBlk : USERBLK;
  204.         constructor Init(AParent: PDialog; AnIndx: integer; Hlp: string);
  205.         destructor Done; virtual;
  206.         function TestIndex(AnIndx: integer): boolean; virtual;
  207.         function TestID(AnID: integer): boolean; virtual;
  208.         function TestShortCut(Key: integer): boolean; virtual;
  209.         procedure SetShortCut(Key: char); virtual;
  210.         procedure SetFlags(Mask: byte; OnOff: boolean); virtual;
  211.         function IsFlagSet(Mask: byte): boolean;
  212.         procedure SetState(StateFlag: integer); virtual;
  213.         function GetState: integer; virtual;
  214.         procedure Disable; virtual;
  215.         procedure Enable; virtual;
  216.         procedure SetColor(Color: integer); virtual;
  217.         function GetColor: integer; virtual;
  218.         procedure Hide(Draw: boolean); virtual;
  219.         procedure Unhide; virtual;
  220.         function IsHidden: boolean; virtual;
  221.         procedure DisableTransfer; virtual;
  222.         procedure EnableTransfer; virtual;
  223.         function Transfer(DataPtr: pointer; TransferFlag: word): word; virtual;
  224.         procedure Changed(AnIndx: integer; DblClick: boolean); virtual;
  225.         procedure Paint; virtual;
  226.         function IsHelpAvailable: boolean; virtual;
  227.         function GetHelp: string; virtual;
  228.         procedure SetHelp(Hlp: string); virtual;
  229.         function Previous: PControl;
  230.         function Next: PControl;
  231.         private
  232.         Prev,
  233.         Nxt     : PControl;
  234.         BHelp   : PString;
  235.         shortcut: integer
  236.     end;
  237.  
  238.     PButton      = ^TButton;
  239.     TButton      = object(TControl)
  240.         public
  241.         constructor Init(AParent: PDialog; AnIndx,AnID: integer; UserDef: boolean; Hlp: string);
  242.         destructor Done; virtual;
  243.         function Install: boolean; virtual;
  244.         procedure Deinstall; virtual;
  245.         procedure SetText(ATextString: string); virtual;
  246.         function GetText: string; virtual;
  247.         private
  248.         oldflags,
  249.         oldstate: word;
  250.         function GetRawText: string;
  251.     end;
  252.  
  253.     PStatic      = ^TStatic;
  254.     TStatic      = object(TControl)
  255.         public
  256.         TextLen: integer;
  257.         constructor Init(AParent: PDialog; AnIndx,ATextLen: integer; UserDef: boolean; Hlp: string);
  258.         destructor Done; virtual;
  259.         function Transfer(DataPtr: pointer; TransferFlag: word): word; virtual;
  260.         procedure SetText(ATextString: string); virtual;
  261.         function GetText: string; virtual;
  262.         function GetTextLen: integer; virtual;
  263.         procedure Clear; virtual;
  264.         private
  265.         oldflags,
  266.         oldtype : word;
  267.         usrused : boolean
  268.     end;
  269.  
  270.     PEdit        = ^TEdit;
  271.     TEdit        = object(TStatic)
  272.         public
  273.         Validator: PValidator;
  274.         Clipboard: PClipboard;
  275.         constructor Init(AParent: PDialog; AnIndx,ATextLen: integer; Hlp: string);
  276.         destructor Done; virtual;
  277.         procedure SetState(StateFlag: integer); virtual;
  278.         procedure SetText(ATextString: string); virtual;
  279.         procedure SetColor(Color: integer); virtual;
  280.         procedure Paint; virtual;
  281.         procedure Clear; virtual;
  282.         procedure Edit; virtual;
  283.         function IsValid(ReportError: boolean): boolean; virtual;
  284.         function CanClose: boolean; virtual;
  285.         function CanUndo: boolean; virtual;
  286.         procedure Undo; virtual;
  287.         procedure Paste; virtual;
  288.         procedure Copy; virtual;
  289.         procedure Cut; virtual;
  290.         procedure Focus; virtual;
  291.         function IsModified: boolean; virtual;
  292.         procedure ClearModify; virtual;
  293.         procedure SetValidator(AValid: PValidator); virtual;
  294.         procedure SetCursor(CPos: integer); virtual;
  295.         function GetCursor: integer; virtual;
  296.         function GetClipboard: PClipboard; virtual;
  297.         private
  298.         Uptr,
  299.         TPtr     : PChar;
  300.         modified : boolean;
  301.         EdIdx    : integer
  302.     end;
  303.  
  304.     PPopup       = ^TPopup;
  305.     TPopup       = object(TEvent)
  306.         public
  307.         PopTree: PTree;
  308.         pX,
  309.         pY,
  310.         pIndex,
  311.         pRows,
  312.         pMax,
  313.         pFlag  : integer;
  314.         constructor Init(AParent: PEventObject; tIndx,oIndx: integer);
  315.         procedure SetPopTree(tree: PTree); virtual;
  316.         function Execute: integer; virtual;
  317.         function ExitPop(mX,mY: integer): integer; virtual;
  318.         function KeyExit(Stat,Key: integer): integer; virtual;
  319.         procedure SetSelection(nr: integer); virtual;
  320.         function GetSelection: integer; virtual;
  321.         procedure SetText(nr: integer; ATextString: string); virtual;
  322.         function GetText(nr: integer): string; virtual;
  323.         procedure SetState(nr,StateFlag: integer); virtual;
  324.         function GetState(nr: integer): integer; virtual;
  325.         procedure Disable(nr: integer); virtual;
  326.         procedure Enable(nr: integer); virtual;
  327.         procedure SetCheck(nr,CheckFlag: integer); virtual;
  328.         function GetCheck(nr: integer): integer; virtual;
  329.         procedure Check(nr: integer); virtual;
  330.         procedure Uncheck(nr: integer); virtual;
  331.         procedure Toggle(nr: integer); virtual;
  332.         private
  333.         mnusr : USERBLK;
  334.         shadow,
  335.         wait0,
  336.         active: boolean;
  337.         obj   : integer;
  338.         procedure MouseSim(sobj: integer);
  339.         function isanyenabled: boolean;
  340.     end;
  341.  
  342.     PScroller    = ^TScroller;
  343.     TScroller    = object(TObject)
  344.         public
  345.         Window       : PWindow;
  346.         XUnit,
  347.         YUnit        : integer;
  348.         XPos,
  349.         Ypos,
  350.         XRange,
  351.         YRange,
  352.         XLine,
  353.         YLine,
  354.         XPage,
  355.         YPage        : longint;
  356.         Style        : word;
  357.         TrackMode,
  358.         HasHScrollBar,
  359.         HasVScrollBar: boolean;
  360.         constructor Init(TheWindow: PWindow; TheXUnit,TheYUnit: integer; TheXRange,TheYRange: longint);
  361.         destructor Done; virtual;
  362.         procedure HScroll; virtual;
  363.         procedure VScroll; virtual;
  364.         function IsVisibleRect(X,Y,XExt,YExt: longint): boolean; virtual;
  365.         procedure ScrollBy(dX,dY: longint); virtual;
  366.         procedure ScrollTo(X,Y: longint); virtual;
  367.         procedure SetPageSize; virtual;
  368.         procedure SetSBarRange; virtual;
  369.         procedure SetRange(TheXRange,TheYRange: longint); virtual;
  370.         procedure SetUnits(TheXUnit,TheYUnit: integer); virtual;
  371.         function GetXOrg: longint; virtual;
  372.         function GetYOrg: longint; virtual;
  373.         private
  374.         procedure RedrawParent(xdif,ydif: integer);
  375.     end;
  376.  
  377.     TWindow      = object(TEventObject)
  378.         public
  379.         Attr     : TWindowAttr;
  380.         Class    : TWndClass;
  381.         IconClass: TIconWndClass;
  382.         Parent,
  383.         ChildList: PWindow;
  384.         Scroller : PScroller;
  385.         Icon     : PIcon;
  386.         DlgTree  : PTree;
  387.         Full,
  388.         Curr,
  389.         Work     : GRECT;
  390.         vdiHandle: integer;
  391.         Clipboard: PClipboard;
  392.         constructor Init(AParent: PWindow; ATitle: string);
  393.         destructor Done; virtual;
  394.         function GetStyle: integer; virtual;
  395.         function GetScroller: PScroller; virtual;
  396.         function GetClipboard: PClipboard; virtual;
  397.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  398.         procedure GetIconWindowClass(var AWndClass: TIconWndClass); virtual;
  399.         function GetClassName: string; virtual;
  400.         function GetIconTitle: string; virtual;
  401.         function GetTitle: string;
  402.         function CanClose: boolean; virtual;
  403.         function IsIconified: boolean;
  404.         function IsModeless: boolean;
  405.         function IsDialog: boolean; virtual;
  406.         function IsTop: boolean; virtual;
  407.         procedure EnableAutoCreate;
  408.         procedure DisableAutoCreate;
  409.         procedure GetFull; virtual;
  410.         procedure GetCurr; virtual;
  411.         procedure GetWork; virtual;
  412.         procedure SetCurr(r: GRECT); virtual;
  413.         procedure SetWork(r: GRECT); virtual;
  414.         procedure LoadIcon(Icn: PIcon); virtual;
  415.         procedure FreeIcon; virtual;
  416.         procedure LoadMenu(Indx: integer); virtual;
  417.         procedure FreeMenu; virtual;
  418.         procedure LoadToolbar(Indx: integer; Opposite: boolean); virtual;
  419.         procedure FreeToolbar; virtual;
  420.         procedure LoadDialog(Indx: integer); virtual;
  421.         procedure FreeDialog; virtual;
  422.         procedure SetDlgTree(tree: PTree); virtual;
  423.         procedure UpdateDialog; virtual;
  424.         procedure SetupSize; virtual;
  425.         procedure SetupWindow; virtual;
  426.         procedure ShutdownWindow; virtual;
  427.         procedure MakeWindow; virtual;
  428.         procedure Create; virtual;
  429.         procedure CreateChildren; virtual;
  430.         procedure OpenWindow; virtual;
  431.         procedure CloseWindow; virtual;
  432.         procedure Destroy; virtual;
  433.         procedure RawDestroy; virtual;
  434.         procedure Top; virtual;
  435.         procedure FullSize; virtual;
  436.         procedure Size(r: GRECT); virtual;
  437.         procedure Move(r: GRECT); virtual;
  438.         procedure InitPaint; virtual;
  439.         procedure Paint(var PaintInfo: TPaintStruct); virtual;
  440.         procedure IconPaint(var PaintInfo: TPaintStruct); virtual;
  441.         procedure ExitPaint; virtual;
  442.         procedure ForceRedraw; virtual;
  443.         procedure SetTitle(ATitle: string); virtual;
  444.         procedure SetSubTitle(AnInfo: string); virtual;
  445.         procedure SetGadgets(Style: integer); virtual;
  446.         procedure SetCursor(Crs: HCursor); virtual;
  447.         procedure Calc(ctype: integer; ri: GRECT; var ro: GRECT); virtual;
  448.         procedure ChkAlign(var r: GRECT); virtual;
  449.         procedure ChkSize(var r: GRECT); virtual;
  450.         procedure GetWorkMin(var minX,minY: integer); virtual;
  451.         procedure GetWorkMax(var maxX,maxY: integer); virtual;
  452.         function GetDC: integer; virtual;
  453.         procedure ReleaseDC; virtual;
  454.         procedure MNSelected(meNum,mtNum: integer; Tree: PTree; PrIndx: integer); virtual;
  455.         procedure HandleMenu(meNum: integer); virtual;
  456.         procedure WMRedraw(X,Y,W,H: integer); virtual;
  457.         procedure WMTopped; virtual;
  458.         procedure WMClosed; virtual;
  459.         procedure WMFulled; virtual;
  460.         procedure WMArrowed(waA,SpeedA,waB,SpeedB: integer); virtual;
  461.         procedure WMHSlid(Value: integer); virtual;
  462.         procedure WMVSlid(Value: integer); virtual;
  463.         procedure WMSized(X,Y,W,H: integer); virtual;
  464.         procedure WMMoved(X,Y,W,H: integer); virtual;
  465.         procedure WMButton(mX,mY,BStat,KStat,Clicks: integer); virtual;
  466.         procedure WMClick(mX,mY,KStat: integer); virtual;
  467.         procedure WMDblClick(mX,mY,KStat: integer); virtual;
  468.         procedure WMRButton(mX,mY,KStat,Clicks: integer); virtual;
  469.         procedure WMRubbox(r: GRECT); virtual;
  470.         procedure WMRBoxChanged(r: GRECT); virtual;
  471.         procedure WMRBoxCheck(x,y,xmin,ymin,xmax,ymax: integer; var mx,my: integer); virtual;
  472.         procedure WMNewTop; virtual;
  473.         procedure WMUntopped; virtual;
  474.         procedure WMOnTop; virtual;
  475.         procedure WMBottomed; virtual;
  476.         procedure WMToolbar(Indx,BStat,KStat,Clicks: integer); virtual;
  477.         function WMKeyDown(Stat,Key: integer): boolean; virtual;
  478.         procedure WMDragDrop(PipeHnd,OrgID,mX,mY,KStat: integer); virtual;
  479.         procedure WMIconify(iX,iY,iW,iH: integer); virtual;
  480.         procedure WMUniconify(oX,oY,oW,oH: integer); virtual;
  481.         procedure WMShaded; virtual;
  482.         procedure WMUnshaded; virtual;
  483.         function DDGetPreferredTypes: string; virtual;
  484.         function DDGetPath: string; virtual;
  485.         function DDHeaderReply(dType,dName,fName: string; dSize: longint; OrgID,mX,mY,KStat: integer): byte; virtual;
  486.         function DDReadData(dType,dName,fName: string; dSize: longint; PipeHnd,OrgID,mX,mY,KStat: integer): boolean; virtual;
  487.         function DDReadArgs(dSize: longint; PipeHnd,OrgID,mX,mY,KStat: integer): boolean; virtual;
  488.         procedure DDFinished(OrgID,mX,mY,KStat: integer); virtual;
  489.         procedure Cut; virtual;
  490.         procedure Copy; virtual;
  491.         procedure Paste; virtual;
  492.         procedure Delete; virtual;
  493.         procedure SelectAll; virtual;
  494.         procedure Print; virtual;
  495.         function Previous: PWindow;
  496.         function Next: PWindow;
  497.         function At(Index: integer): PWindow;
  498.         function IndexOf(Item: PWindow): integer;
  499.         function FirstWndThat(Test: PIterationFunc): PWindow;
  500.         procedure ForEachWnd(Action: PIterationProc);
  501.         procedure IconSelect(OnOff: boolean; OffExc: integer); virtual;
  502.         function FirstIcon(OnAll: boolean): PIcon; virtual;
  503.         function NextIcon: PIcon; virtual;
  504.         function FirstWorkRect(var Rect: GRECT): boolean; virtual;
  505.         function NextWorkRect(var Rect: GRECT): boolean; virtual;
  506.         private
  507.         Prev,
  508.         Nxt     : PWindow;
  509.         nxticn  : PEvent;
  510.         icnonall: boolean;
  511.         icntitl : PString;
  512.         icnx,
  513.         tbsize,
  514.         tbtree,
  515.         icfpos,
  516.         icfstyle,
  517.         mnsize  : integer;
  518.         icfcurr : GRECT;
  519.         procedure EnableCrsWatch;
  520.         procedure DisableCrsWatch;
  521.         procedure Iconify(fade: boolean);
  522.         function CycleTop(start: PWindow; backwrd: boolean): boolean;
  523.     end;
  524.  
  525.     PApplication = ^TApplication;
  526.     TApplication = object(TEventObject)
  527.         public
  528.         Name,
  529.         apName,
  530.         apPath       : PString;
  531.         ID           : TCookieID;
  532.         Status,
  533.         vdiHandle,
  534.         aesHandle,
  535.         apID,
  536.         menuID       : integer;
  537.         workIn       : workin_ARRAY;
  538.         workOut      : workout_ARRAY;
  539.         Attr         : TGEMAttr;
  540.         XAcc         : TXAccAttr;
  541.         XAccList     : PCollection;
  542.         Icon         : PIcon;
  543.         Clipboard    : PClipboard;
  544.         MetaDOS      : PMetaInfo;
  545.         MainWindow   : PWindow;
  546.         RscPtr       : PRsFile;
  547.         MenuTree     : PTree;
  548.         MessageBuffer: pointer;
  549.         MessageBLen,
  550.         AVServer     : integer;
  551.         apDTA        : DTA;
  552.         FirstInstance,
  553.         SpeedoActive,
  554.         GDOSActive,
  555.         MultiTOS,
  556.         MiNTActive,
  557.         IsQSBUsed,
  558.         FPUAvailable,
  559.         OSBAvailable : boolean;
  560.         constructor Init(AnID: TCookieID; AName: string);
  561.         destructor Done; virtual;
  562.         function CanClose: boolean; virtual;
  563.         function IsIconified: boolean;
  564.         procedure LoadResource(FileHiRes,FileLoRes: string); virtual;
  565.         procedure InitResource(AddrHiRes,AddrLoRes: pointer); virtual;
  566.         function GetAddr(Indx: integer): PTree; virtual;
  567.         function GetFImagePtr(Indx: integer): pointer; virtual;
  568.         function GetFStringPtr(Indx: integer): PChar; virtual;
  569.         function GetFString(Indx: integer): string; virtual;
  570.         function GetIconTitle: string; virtual;
  571.         function GetClipboard: PClipboard; virtual;
  572.         procedure GetXAccAttr(var XAccAttr: TXAccAttr); virtual;
  573.         function SendWndMessage(gHnd: integer; Msg: pointer; sID,Icn: boolean): boolean; virtual;
  574.         procedure Broadcast(Msg: pointer; sID: boolean); virtual;
  575.         function FindApplication(AName: string; AnID: integer; var XAccAttr: TXAccAttr): boolean; virtual;
  576.         function FirstApplication(AType: TAppTypeMR; GenName: string; var XAccAttr: TXAccAttr): boolean;
  577.         function NextApplication(var XAccAttr: TXAccAttr): boolean;
  578.         procedure FreeResource; virtual;
  579.         procedure InstallDesktop(tIndx,oIndx: integer); virtual;
  580.         procedure RemoveDesktop; virtual;
  581.         procedure LoadIcon(icnTree,icnIndx: integer); virtual;
  582.         procedure FreeIcon; virtual;
  583.         procedure LoadMenu(Indx: integer); virtual;
  584.         procedure DrawMenu; virtual;
  585.         procedure FreeMenu; virtual;
  586.         function AutoFolder: boolean; virtual;
  587.         procedure InitGEM; virtual;
  588.         procedure ExitGEM; virtual;
  589.         procedure SetupVDI; virtual;
  590.         procedure InitApplication; virtual;
  591.         procedure InitInstance; virtual;
  592.         procedure InitMainWindow; virtual;
  593.         function GetCurrInstance: integer; virtual;
  594.         function GetGPWindow(gHnd: integer): PWindow;
  595.         function GetPWindow(Hnd: HWnd): PWindow;
  596.         function GetPTopWindow: PWindow;
  597.         function GetMsTimer: longint; virtual;
  598.         procedure GetCrsRect(var crect: GRECT); virtual;
  599.         function GetEvent(var data: TEventData): integer; virtual;
  600.         procedure MessageLoop; virtual;
  601.         procedure MUKeybd(data: TEventData); virtual;
  602.         procedure MUButton(data: TEventData); virtual;
  603.         procedure MURubbox(r: GRECT); virtual;
  604.         procedure MURBoxChanged(r: GRECT); virtual;
  605.         procedure MUM1(data: TEventData); virtual;
  606.         procedure MUM2(data: TEventData); virtual;
  607.         procedure MUMesag(data: TEventData); virtual;
  608.         procedure MUTimer(data: TEventData); virtual;
  609.         procedure MNSelected(meNum,mtNum: integer; Tree: PTree; PrIndx: integer); virtual;
  610.         procedure ACOpen(mID: integer); virtual;
  611.         function ACClose(mID,Why: integer): integer; virtual;
  612.         function APTerm(Why: integer): integer; virtual;
  613.         procedure APDragDrop(PipeID,OrgID,WindID,mX,mY,KStat: integer); virtual;
  614.         procedure ShutCompleted(Stat,ErrID,ErrCode: integer); virtual;
  615.         procedure ResChCompleted(Stat: integer); virtual;
  616.         procedure CHExit(ChID,ChRet: integer); virtual;
  617.         procedure SHWDraw(Drive: integer); virtual;
  618.         procedure SCChanged(OrgID: integer; Bits: word; Ext: string); virtual;
  619.         procedure XAccID(OrgID,mID: integer; Msg,Ver: byte; pName: PChar); virtual;
  620.         procedure XAccAcc(accID,mID: integer; Msg,Ver: byte; pName: PChar); virtual;
  621.         function XAccInsert(accID,mID: integer; Msg,Ver: byte; pName: PChar): boolean; virtual;
  622.         procedure XAccExit(OrgID: integer); virtual;
  623.         function XAccText(OrgID: integer; pText: pointer): boolean; virtual;
  624.         function XAccKey(OrgID,Stat,Key: integer): boolean; virtual;
  625.         function XAccMeta(OrgID: integer; pData: pointer; lData: longint; Final: boolean): boolean; virtual;
  626.         function XAccIMG(OrgID: integer; pData: pointer; lData: longint; Final: boolean): boolean; virtual;
  627.         procedure AVProtokoll(OrgID: integer; Msg: word; AName: string); virtual;
  628.         procedure VAProtoStatus(OrgID: integer; Msg: word; AName: string); virtual;
  629.         function AVInsert(accID: integer; SrvMsg,AccMsg: word; AName: string): boolean; virtual;
  630.         procedure AVExit(OrgID: integer); virtual;
  631.         function DDGetPreferredTypes(WindID: integer): string; virtual;
  632.         function DDGetPath(WindID: integer): string; virtual;
  633.         function DDHeaderReply(dType,dName,fName: string; dSize: longint; OrgID,WindID,mX,mY,KStat: integer): byte; virtual;
  634.         function DDReadData(dType,dName,fName: string; dSize: longint; PipeHnd,OrgID,WindID,mX,mY,KStat: integer): boolean; virtual;
  635.         function DDReadArgs(dSize: longint; PipeHnd,OrgID,WindID,mX,mY,KStat: integer): boolean; virtual;
  636.         procedure DDFinished(OrgID,WindID,mX,mY,KStat: integer); virtual;
  637.         procedure Cut; virtual;
  638.         procedure Copy; virtual;
  639.         procedure Paste; virtual;
  640.         procedure Delete; virtual;
  641.         procedure SelectAll; virtual;
  642.         procedure HandleDragDrop(PipeHnd,OrgID,WindID,mX,mY,KStat: integer); virtual;
  643.         procedure HandleKeybd(Stat,Key: integer); virtual;
  644.         procedure HandleButton(mX,mY,BStat,KStat,Clicks: integer); virtual;
  645.         procedure HandleM1(mX,mY,BStat,KStat: integer); virtual;
  646.         procedure HandleM2(mX,mY,BStat,KStat: integer); virtual;
  647.         procedure HandleMesag(Pipe: Pipearray); virtual;
  648.         procedure HandleAV(Pipe: Pipearray); virtual;
  649.         procedure HandleXAcc(Pipe: Pipearray); virtual;
  650.         procedure HandleTimer; virtual;
  651.         procedure HandleMenu(meNum: integer); virtual;
  652.         procedure HandleError; virtual;
  653.         procedure Terminate; virtual;
  654.         procedure Run; virtual;
  655.         procedure Quit; virtual;
  656.         function At(Index: integer): PWindow;
  657.         function IndexOf(Item: PWindow): integer;
  658.         function FirstWndThat(Test: PIterationFunc): PWindow;
  659.         procedure ForEachWnd(Action: PIterationProc);
  660.         function FirstIcon(OnAll: boolean): PIcon; virtual;
  661.         function NextIcon: PIcon; virtual;
  662.         procedure IconSelect(OnOff: boolean; OffExc: integer); virtual;
  663.         procedure IconPaint(Work: GRECT; var PaintInfo: TPaintStruct); virtual;
  664.         procedure BubbleHelp(mX,mY: integer; Delay: word; Hlp: string); virtual;
  665.         function ExecDialog(ADialog: PDialog): integer; virtual;
  666.         function Alert(AParent: PWindow; DefBtn: integer; Sign: longint; Txt,Btn: string): integer; virtual;
  667.         function Popup(APopup: PPopup; x,y,Flag: integer): integer; virtual;
  668.         function Rubbox(WHnd,x,y,xmin,ymin,xmax,ymax: integer; IconSel: boolean; var r: GRECT): boolean; virtual;
  669.         procedure InvalidateRect(Wnd: HWnd; Rect: PGRECT); virtual;
  670.         procedure RestoreModalDialog(p: PWindow); virtual;
  671.         procedure DeskRedraw; virtual;
  672.         procedure SetQuit(mNum,tNum: integer); virtual;
  673.         procedure GetMenuEntries(var Entries: TMenuEntries); virtual;
  674.         function ChkError: integer; virtual;
  675.         function ChkSpeedoError: integer; virtual;
  676.         procedure Error(ErrorCode: integer); virtual;
  677.         private
  678.         Err,
  679.         DlgTop,
  680.         ticn,
  681.         iicn       : integer;
  682.         nxtapp     : longint;
  683.         termflag,
  684.         allicn,
  685.         ddokflag,
  686.         icnonall   : boolean;
  687.         napptype   : TAppTypeMR;
  688.         nappgen    : PString;
  689.         nxticn     : PEvent;
  690.         HMax       : HWnd;
  691.         mnusr      : USERBLK;
  692.         pquit      : PKeyMenu;
  693.         pcrswatch,
  694.         icnwnd     : PWindow;
  695.         wmnr       : HCursor;
  696.         wmform     : MFORM;
  697.         xaccname   : PChar;
  698.         menuentries: PMenuEntries;
  699.         function getcval: longint;
  700.         procedure MoveIcons(Wnd: PEventObject; Icn: PIcon; gHnd,mX,mY: integer);
  701.         function GetObjectParent(tree: PTree; indx: integer): integer;
  702.         function find_object(tree: PTree; start,which: integer): integer;
  703.         function ini_field(tree: PTree; start: integer): integer;
  704.         function form_keybd(fo_ktree: PTree; fo_kobject,fo_kobnext,fo_kchar: integer; var fo_knxtobject,fo_knxtchar: integer): integer;
  705.         function form_button(pd: PDialog; fo_bobject,fo_bclicks: integer; var fo_bnxtobj: integer): boolean;
  706.         procedure GOErrAlert(sign: integer; msg: string);
  707.         function XAccMR2HR(MR: TAppTypeMR): string;
  708.         function AlertBubbleWrap(txt: string; width: integer): string;
  709.         procedure    FixResource(raddr: pointer; mode,what: boolean);
  710.         function MenuCorrect(mt: PTree; var i: integer): boolean;
  711.         procedure MenuTune;
  712.         procedure TitleSelect(pw: PWindow; indx: integer; select: boolean);
  713.     end;
  714.  
  715.     TDialog      = object(TWindow)
  716.         public
  717.         CtrlList      : PControl;
  718.         TransferBuffer: pointer;
  719.         IsModal,
  720.         Cont          : boolean;
  721.         Result        : integer;
  722.         constructor Init(AParent: PWindow; ATitle: string; Indx: integer);
  723.         destructor Done; virtual;
  724.         function GetStyle: integer; virtual;
  725.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  726.         function GetClassName: string; virtual;
  727.         function GetKBHandler: PEvent; virtual;
  728.         function IsDialog: boolean; virtual;
  729.         procedure LoadDialog(Indx: integer); virtual;
  730.         procedure UpdateDialog; virtual;
  731.         procedure SetupSize; virtual;
  732.         procedure SetupWindow; virtual;
  733.         procedure MakeWindow; virtual;
  734.         procedure Create; virtual;
  735.         procedure OpenWindow; virtual;
  736.         procedure CloseWindow; virtual;
  737.         procedure Destroy; virtual;
  738.         procedure Paint(var PaintInfo: TPaintStruct); virtual;
  739.         procedure ObjcPaint(Indx: integer; Lazy: boolean); virtual;
  740.         procedure GetWorkMax(var maxX,maxY: integer); virtual;
  741.         procedure WMClosed; virtual;
  742.         procedure WMButton(mX,mY,BStat,KStat,Clicks: integer); virtual;
  743.         procedure Execute; virtual;
  744.         procedure EndDlg(Indx: integer; DblClick: boolean); virtual;
  745.         procedure TransferData(Direction: word); virtual;
  746.         function ExitDlg(AnIndx: integer): boolean; virtual;
  747.         function OK: boolean; virtual;
  748.         function Cancel: boolean; virtual;
  749.         function Help: boolean; virtual;
  750.         function Undo: boolean; virtual;
  751.         function Esc: boolean; virtual;
  752.         procedure Cut; virtual;
  753.         procedure Copy; virtual;
  754.         procedure Paste; virtual;
  755.         procedure Delete; virtual;
  756.         function FirstThat(Test: PIterationFunc): PControl;
  757.         procedure ForEach(Action: PIterationProc);
  758.         procedure InitFocus; virtual;
  759.         procedure SetFocus(Obj: integer); virtual;
  760.         function GetFocus: integer; virtual;
  761.         procedure CallChanged(Indx: integer; dclk,edt,push: boolean); virtual;
  762.         private
  763.         edit_obj,
  764.         next_obj,
  765.         wmaxw,
  766.         wmaxh,
  767.         idx     : integer;
  768.         BValid,
  769.         d0fly,
  770.         bsave,
  771.         obedflag: boolean;
  772.         BackGr  : MFDB;
  773.         BLen,
  774.         frwid   : longint;
  775.         kbdh    : PEvent;
  776.         pedt    : PEdit;
  777.         procedure MoveDial(mX,mY: integer);
  778.         procedure SaveBackground;
  779.         procedure RestoreBackground;
  780.         function objc_edit(var ob_edchar: integer; ob_edkind: integer; clp: ARRAY_4; cclp: boolean): integer;
  781.     end;
  782.  
  783.     PToolbar     = ^TToolbar;
  784.     TToolbar     = object(TEvent)
  785.         public
  786.         ADialog : PDialog;
  787.         VKey,
  788.         VStat,
  789.         ObjTree,
  790.         ObjIndx : integer;
  791.         ObjAddr : PObj;
  792.         VPipe   : PPipearray;
  793.         VGHnd   : boolean;
  794.         constructor Init(AParent: PWindow; ATree,AnIndx,Stat,Key: integer; Msg: pointer; GetHnd,Switch: boolean; Hlp: string);
  795.         destructor Done; virtual;
  796.         function TestKey(Stat,Key: integer): boolean; virtual;
  797.         function TestMessage(Pipe: Pipearray): boolean; virtual;
  798.         function GetState: integer; virtual;
  799.         procedure SetState(StateFlag: integer); virtual;
  800.         procedure Disable; virtual;
  801.         procedure Enable; virtual;
  802.         procedure SetCheck(CheckFlag: integer); virtual;
  803.         function GetCheck: integer; virtual;
  804.         procedure Check; virtual;
  805.         procedure Uncheck; virtual;
  806.         procedure Toggle; virtual;
  807.         procedure Paint; virtual;
  808.         function IsHelpAvailable: boolean; virtual;
  809.         function GetHelp: string; virtual;
  810.         procedure SetHelp(Hlp: string); virtual;
  811.         procedure SetMenuIndex(Indx: byte); virtual;
  812.         function GetMenuIndex: byte; virtual;
  813.         procedure ClearMenuIndex; virtual;
  814.         private
  815.         IsSwitch: boolean;
  816.         BHelp   : PString
  817.     end;
  818.  
  819.     TKeyMenu     = object(TEvent)
  820.         public
  821.         ADialog: PDialog;
  822.         VStat,
  823.         VKey,
  824.         VMNum,
  825.         VTNum  : integer;
  826.         VPipe  : PPipearray;
  827.         VGHnd  : boolean;
  828.         constructor Init(AParent: PEventObject; Stat,Key,mNum,tNum: integer);
  829.         destructor Done; virtual;
  830.         function TestKey(Stat,Key: integer): boolean; virtual;
  831.         function TestMenu(mNum: integer): boolean; virtual;
  832.         function GetState: integer; virtual;
  833.         procedure SetState(StateFlag: integer); virtual;
  834.         procedure Disable; virtual;
  835.         procedure Enable; virtual;
  836.         function GetText: string; virtual;
  837.         procedure SetText(ATextString: string); virtual;
  838.         function GetCheck: integer; virtual;
  839.         procedure SetCheck(CheckFlag: integer); virtual;
  840.         procedure Check; virtual;
  841.         procedure Uncheck; virtual;
  842.         procedure Toggle; virtual;
  843.         private
  844.         function InitMWrk: boolean;
  845.         procedure ExitMWrk;
  846.         function IsApp: boolean;
  847.         function GetMenuTree: PTree;
  848.     end;
  849.  
  850.     PKey         = ^TKey;
  851.     TKey         = object(TKeyMenu)
  852.         public
  853.         constructor Init(AParent: PEventObject; Stat,Key: integer; Msg: pointer; GetHnd: boolean);
  854.         function TestMenu(mNum: integer): boolean; virtual;
  855.     end;
  856.  
  857.     PMenu        = ^TMenu;
  858.     TMenu        = object(TKeyMenu)
  859.         public
  860.         constructor Init(AParent: PEventObject; mNum: integer; Msg: pointer; GetHnd: boolean);
  861.         function TestKey(Stat,Key: integer): boolean; virtual;
  862.     end;
  863.  
  864.  
  865. var
  866.  
  867.     Application: PApplication;
  868.     pxya       : ptsin_ARRAY;
  869.     SysInfo    : record
  870.         BGDefCol,
  871.         SFHeight,
  872.         SFWidth : integer
  873.     end;
  874.     GP         : record
  875.         charWidth,
  876.         charHeight,
  877.         boxWidth,
  878.         boxHeight,
  879.         horAlign,
  880.         verAlign,
  881.         wrmode,
  882.         ltype,
  883.         lwidth,
  884.         lcolor,
  885.         mtype,
  886.         mheight,
  887.         mcolor,
  888.         tpoint,
  889.         theight,
  890.         trotation,
  891.         teffects,
  892.         tcolor,
  893.         fstyle,
  894.         fcolor,
  895.         finterior,
  896.         fperimeter,
  897.         lendsb,
  898.         lendse,
  899.         ludsty,
  900.         font      : integer;
  901.         mnr       : HCursor;
  902.         mform     : MFORM;
  903.         clip      : ARRAY_4
  904.     end;
  905.  
  906.  
  907. procedure UpdateGPValues;
  908. function GEMVersion: word;
  909. function IsDesktopActive: boolean;
  910. procedure GetQSB(var p: pointer; var len: longint);
  911. function GetTempDir: string;
  912. function GetHomeDir(RootDefault: boolean): string;
  913. function FileSelect(AParent: PWindow; ATitle,AMask: string; var APath,AFile: string; ForceExist: boolean): boolean;
  914. function OpenPrivateProfile(FileName: string): boolean;
  915. function SavePrivateProfile: boolean;
  916. function ClosePrivateProfile: boolean;
  917. function WritePrivateProfileString(AppName,KeyName,Value,FileName: string): boolean;
  918. function WritePrivateProfileInt(AppName,KeyName: string; Value: longint; FileName: string): boolean;
  919. function GetPrivateProfileString(AppName,KeyName,Default,FileName: string): string;
  920. function GetPrivateProfileInt(AppName,KeyName: string; Default: longint; FileName: string): longint;
  921. function WriteProfileString(AppName,KeyName,Value: string): boolean;
  922. function WriteProfileInt(AppName,KeyName: string; Value: longint): boolean;
  923. function GetProfileString(AppName,KeyName,Default: string): string;
  924. function GetProfileInt(AppName,KeyName: string; Default: longint): longint;
  925. procedure vr_convert(handle: integer; psrcMFDB: MFDB; format: integer);
  926. procedure vdi_fix(var pfd: MFDB; theAddr: pointer; w,h: integer);
  927. procedure SetMouse(mX,mY: integer);
  928. function IsMouseVisible: boolean;
  929. function IsMouseBusy: boolean;
  930. procedure ShowMouse;
  931. procedure HideMouse;
  932. procedure ArrowMouse;
  933. procedure BusyMouse;
  934. procedure SliceMouse;
  935. procedure SliceMouseNext;
  936. procedure LastMouse;
  937.  
  938.  
  939. { Achtung: Auf die Existenz der folgenden Routinen im interface-Teil darf man
  940.            sich NICHT verlassen (sie sind auch nicht dokumentiert...)!!!      }
  941.  
  942. function graf_mouse(gr_monumber: word; gr_mofaddr: MFORMPtr): integer;
  943. function vswr_mode(handle,mode: integer): integer;
  944. procedure vsl_udsty(handle,pattern: integer);
  945. function vsl_type(handle,style: integer): integer;
  946. function vsl_width(handle,width: integer): integer;
  947. function vsl_color(handle,color_index: integer): integer;
  948. procedure vsl_ends(handle,beg_style,end_style: integer);
  949. function vsm_type(handle,symbol: integer): integer;
  950. function vsm_height(handle,height: integer): integer;
  951. function vsm_color(handle,color_index: integer): integer;
  952. function vst_font(handle,font: integer): integer;
  953. function vst_point(handle,point: integer; var char_width,char_height,cell_width,cell_height: integer): integer;
  954. procedure vst_height(handle,height: integer; var char_width,char_height,cell_width,cell_height: integer);
  955. function vst_rotation(handle,angle: integer): integer;
  956. function vst_effects(handle,effect: integer): integer;
  957. procedure vst_alignment(handle,hor_in,vert_in: integer; var hor_out,vert_out: integer);
  958. function vst_color(handle,color_index: integer): integer;
  959. function vsf_interior(handle,style: integer): integer;
  960. function vsf_style(handle,style_index: integer): integer;
  961. function vsf_color(handle,color_index: integer): integer;
  962. function vsf_perimeter(handle,per_vis: integer): integer;
  963. procedure vs_clip(handle,clipflag: integer; pxarray: ARRAY_4);
  964. procedure vr_trnfm(handle: integer; psrcMFDB,pdesMFDB: MFDB);
  965. procedure InitVWrk;
  966. procedure RestoreVWrk;
  967.  
  968.  
  969.  
  970. implementation
  971.  
  972. uses
  973.  
  974.     Strings,Dos;
  975.  
  976. const
  977.  
  978.     outlwidth          = 3;
  979.     Ctrl_Backdrop      = 25871;
  980.     Ctrl_Fuller        = 26122;
  981.     Ctrl_Iconify       = 28435;
  982.     Ctrl_Cycle         = Ctrl_W;
  983.     Ctrl_Close         = Ctrl_U;
  984.     Ctrl_Quit          = Ctrl_Q;
  985.     MAGIX              = $0399;
  986.     GLOBAL             = $20;
  987.     MFORCE             = $8000;
  988.     FIXRSC             = true;
  989.     UNFIXRSC           = false;
  990.     FIX_ALL            = true;
  991.     FIX_BBONLY         = false;
  992.     POP_MAXROWS        = 19;
  993.     EDDRAW             = 42;
  994.     EDIDX              = 43;
  995.     EDIDXABS           = 44;
  996.     FMD_BACKWARD       = -1;
  997.     FMD_FORWARD        = -2;
  998.     FMD_DEFLT          = -3;
  999.     ICF_GETPOS         = $0001;
  1000.     ICF_FREEPOS        = $0002;
  1001.     RSC_LOADED         : pointer = pointer(1);
  1002.     TEST_BEG_UPDATE    = BEG_UPDATE or $0100;
  1003.     WF_WINX            = 22360;
  1004.     WM_M_BDROPPED      = 100;
  1005.     _SCP               = 1599292240;
  1006.     SYSPROFILE         = 'user.inf';
  1007.  
  1008. type
  1009.  
  1010.     INFOVSCRPtr        = ^INFOVSCR;
  1011.     INFOVSCR           = record
  1012.         cookie,
  1013.         product: longint;
  1014.         version: word;
  1015.         x,y,w,h: integer
  1016.     end;
  1017.  
  1018.     PAESVARS           = ^AESVARS;
  1019.     AESVARS            = record
  1020.         magic      : longint;
  1021.         membot,
  1022.         aes_start  : pointer;
  1023.         magic2     : TCookieID;
  1024.         date       : longint;
  1025.         chgres,
  1026.         shel_vector,
  1027.         aes_bootdrv,
  1028.         vdi_device : pointer;
  1029.         reservd1,
  1030.         reservd2,
  1031.         reservd3   : pointer;
  1032.         version,
  1033.         release    : integer
  1034.     end;
  1035.  
  1036.     PMAGX_COOKIE       = ^MAGX_COOKIE;
  1037.     MAGX_COOKIE        = record
  1038.         config_status: longint;
  1039.         dos_vars     : pointer;
  1040.         aes_vars     : PAESVARS
  1041.     end;
  1042.  
  1043.     PLTMFLY = ^LTMFLY;
  1044.     LTMFLY = record
  1045.         version,
  1046.         config,
  1047.         conf2,
  1048.         reserved     : word;
  1049.         di_fly,
  1050.         obj_clsize,
  1051.         do_key,
  1052.         init_keys,
  1053.         lookup_key,
  1054.         di_moveto,
  1055.         di_center    : pointer;
  1056.         ucol,
  1057.         aicol,
  1058.         aframe,
  1059.         flydelay     : integer;
  1060.         hist_insert,
  1061.         ins_spcchar,
  1062.         init_niceline: pointer
  1063.     end;
  1064.  
  1065.     TedinfoArrayPtr    = ^TedinfoArray;
  1066.     TedinfoArray       = array [0..9999] of TEDINFO;
  1067.  
  1068.     AESTreePtrArrayPtr = ^AESTreePtrArray;
  1069.     AESTreePtrArray    = array [0..9999] of AESTreePtr;
  1070.  
  1071.     FreeStrPtrArrayPtr = ^FreeStrPtrArray;
  1072.     FreeStrPtrArray    = array [0..9999] of PChar;
  1073.  
  1074.     FreeImgPtrArrayPtr = ^FreeImgPtrArray;
  1075.     FreeImgPtrArray    = array [0..9999] of pointer;
  1076.  
  1077.     IconBlockArrayPtr  = ^IconBlockArray;
  1078.     IconBlockArray     = array [0..9999] of ICONBLK;
  1079.  
  1080.     BitBlockArrayPtr   = ^BitBlockArray;
  1081.     BitBlockArray      = array [0..9999] of BITBLK;
  1082.  
  1083.     PDKey              = ^TDKey;
  1084.     TDKey              = object(TEvent)
  1085.         function TestKey(Stat,Key: integer): boolean; virtual;
  1086.     end;
  1087.  
  1088.     PQKey              =  ^TQKey;
  1089.     TQKey              =  object(TKeyMenu)
  1090.         procedure Work; virtual;
  1091.     end;
  1092.  
  1093.     PMenuPopup = ^TMenuPopup;
  1094.     TMenuPopup = object(TPopup)
  1095.         function ExitPop(mX,mY: integer): integer; virtual;
  1096.         function KeyExit(Stat,Key: integer): integer; virtual;
  1097.     end;
  1098.  
  1099.     PIcnWnd            = ^TIcnWnd;
  1100.     TIcnWnd            = object(TWindow)
  1101.         icx,icy,icw,ich: integer;
  1102.         constructor Init(AParent: PWindow; ATitle: string; x,y,w,h: integer);
  1103.         procedure SetupWindow; virtual;
  1104.         procedure MakeWindow; virtual;
  1105.         procedure IconPaint(var PaintInfo: TPaintStruct); virtual;
  1106.     end;
  1107.  
  1108.     PXAccCollection    = ^TXAccCollection;
  1109.     TXAccCollection    = object(TCollection)
  1110.         procedure FreeItem(Item: pointer); virtual;
  1111.     end;
  1112.  
  1113.     PProfileCollection = ^TProfileCollection;
  1114.     TProfileCollection = object(TCollection)
  1115.         procedure FreeItem(Item: pointer); virtual;
  1116.     end;
  1117.  
  1118. var
  1119.  
  1120.     OldExit,
  1121.     icfserver  : pointer;
  1122.     ltmf       : PLTMFLY;
  1123.     appdone,
  1124.     cliplock,
  1125.     deskinst,
  1126.     profilechng: boolean;
  1127.     mhstack,
  1128.     mfstack,
  1129.     spderr,
  1130.     bfalcol,
  1131.     slmouse,
  1132.     poptimer   : integer;
  1133.     lastfa     : longint;
  1134.     bbldelay   : word;
  1135.     mlnr       : HCursor;
  1136.     mlform     : MFORM;
  1137.     DRect      : GRECT;
  1138.     profile    : PProfileCollection;
  1139.     profilename: PString;
  1140.     agi        : record
  1141.         Gadgets    : integer;
  1142.         ColorIcons,
  1143.         ExtRsc,
  1144.         ApplSearch,
  1145.         MenuInq,
  1146.         ExtMnSelect,
  1147.         WindUpdate,
  1148.         Shutdown,
  1149.         Broadcast,
  1150.         MultiProto,
  1151.         Iconify,
  1152.         Backdrop,
  1153.         Owner,
  1154.         BEvent     : boolean
  1155.     end;
  1156.  
  1157.  
  1158. function DrawTitle(dummy1,dummy2: pointer; parm: PARMBLKPtr): word; forward;
  1159. function DrawStatic(dummy1,dummy2: pointer; parm: PARMBLKPtr): word; forward;
  1160. function DrawMenuRect(dummy1,dummy2: pointer; parm: PARMBLKPtr): word; forward;
  1161. function DrawPushButton(dummy1,dummy2: pointer; parm: PARMBLKPtr): word; forward;
  1162. procedure SigHandler(dummy1,dummy2,sig: pointer); forward;
  1163. procedure IconifyFadeout(p: PWindow); forward;
  1164. procedure IconifyFadein(p: PWindow); forward;
  1165. procedure SendXaccExit(p: PXAccAttr); forward;
  1166.  
  1167.  
  1168.  
  1169. { *** Objekt TEVENTOBJECT *** }
  1170.  
  1171. constructor TEventObject.Init;
  1172.  
  1173.   begin
  1174.       if not(inherited Init) then fail;
  1175.       EventList:=nil
  1176.   end;
  1177.  
  1178.  
  1179. destructor TEventObject.Done;
  1180.  
  1181.   begin
  1182.         while (EventList<>nil) do EventList^.Free;
  1183.         inherited Done
  1184.   end;
  1185.  
  1186. { *** TEVENTOBJECT *** }
  1187.  
  1188.  
  1189.  
  1190. { *** Objekt TEVENT *** }
  1191.  
  1192. constructor TEvent.Init(AParent: PEventObject);
  1193.     var p: PEvent;
  1194.  
  1195.     begin
  1196.         if not(inherited Init) then fail;
  1197.         Parent:=AParent;
  1198.         if Parent=nil then Parent:=Application;
  1199.         Style:=0;
  1200.         Prev:=nil;
  1201.         Nxt:=nil;
  1202.         if Parent^.EventList=nil then Parent^.EventList:=@self
  1203.         else
  1204.             begin
  1205.                 p:=Parent^.EventList;
  1206.                 while p^.Nxt<>nil do p:=p^.Nxt;
  1207.                 p^.Nxt:=@self;
  1208.                 Prev:=p
  1209.             end
  1210.     end;
  1211.  
  1212.  
  1213. destructor TEvent.Done;
  1214.  
  1215.     begin
  1216.         if (Prev=nil) and (Nxt=nil) then Parent^.EventList:=nil
  1217.         else
  1218.             begin
  1219.                 if Prev=nil then Parent^.EventList:=Nxt
  1220.                     else Prev^.Nxt:=Nxt;
  1221.                 if Nxt<>nil then Nxt^.Prev:=Prev
  1222.             end;
  1223.         inherited Done
  1224.     end;
  1225.  
  1226.  
  1227. function TEvent.TestKey(Stat,Key: integer): boolean;
  1228.  
  1229.     begin
  1230.         TestKey:=false
  1231.     end;
  1232.  
  1233.  
  1234. function TEvent.TestButton(mX,mY,BStat,KStat,Clicks: integer): boolean;
  1235.  
  1236.     begin
  1237.         TestButton:=false
  1238.     end;
  1239.  
  1240.  
  1241. function TEvent.TestMouse(M,mX,mY,BStat,KStat: integer): boolean;
  1242.  
  1243.     begin
  1244.         TestMouse:=false
  1245.     end;
  1246.  
  1247.  
  1248. function TEvent.TestMessage(Pipe: Pipearray): boolean;
  1249.  
  1250.     begin
  1251.         TestMessage:=false
  1252.     end;
  1253.  
  1254.  
  1255. function TEvent.TestMenu(mNum: integer): boolean;
  1256.  
  1257.     begin
  1258.         TestMenu:=false
  1259.     end;
  1260.  
  1261.  
  1262. procedure TEvent.Work;
  1263.  
  1264.     begin
  1265.     end;
  1266.  
  1267.  
  1268. function TEvent.Previous: PEvent;
  1269.  
  1270.     begin
  1271.         Previous:=Prev
  1272.     end;
  1273.  
  1274.  
  1275. function TEvent.Next: PEvent;
  1276.  
  1277.     begin
  1278.         Next:=Nxt
  1279.     end;
  1280.  
  1281. { *** TEVENT *** }
  1282.  
  1283.  
  1284.  
  1285. { *** Objekt TVALIDATOR *** }
  1286.  
  1287. constructor TValidator.Init;
  1288.  
  1289.     begin
  1290.         if not(inherited Init) then fail;
  1291.         Window:=nil;
  1292.         Status:=vsOK;
  1293.         Options:=0
  1294.     end;
  1295.  
  1296.  
  1297. procedure TValidator.Error;
  1298.  
  1299.     begin
  1300.         if Application<>nil then
  1301.             with Application^ do
  1302.                 begin
  1303.                     if (Attr.Country=FRG) or (Attr.Country=SWG) then
  1304.                         Alert(Window,1,NOTE,'Die Eingabe darf nicht leer sein!','  &OK  ')
  1305.                     else
  1306.                         Alert(Window,1,NOTE,'Input must not be empty!','  &OK  ')
  1307.             end
  1308.     end;
  1309.  
  1310.  
  1311. function TValidator.IsValid(s: string): boolean;
  1312.  
  1313.     begin
  1314.         if bTst(Options,voNotEmpty) then IsValid:=length(s)>0
  1315.         else
  1316.             IsValid:=true
  1317.     end;
  1318.  
  1319.  
  1320. function TValidator.IsValidInput(var s: string; SuppressFill: boolean): boolean;
  1321.  
  1322.     begin
  1323.         IsValidInput:=true
  1324.     end;
  1325.  
  1326.  
  1327. function TValidator.Valid(s: string): boolean;
  1328.  
  1329.     begin
  1330.         if IsValid(s) then Valid:=true
  1331.         else
  1332.             begin
  1333.                 Valid:=false;
  1334.                 Error
  1335.             end
  1336.     end;
  1337.  
  1338. { *** TVALIDATOR *** }
  1339.  
  1340.  
  1341.  
  1342. { *** Objekt TICON *** }
  1343.  
  1344. constructor TIcon.Init(AParent: PEventObject; ATree,AnIndex,iX,iY: integer; Movable,Selectble: boolean; AName,Hlp: string);
  1345.     var tp: PTree;
  1346.  
  1347.     begin
  1348.         if not(inherited Init(AParent)) then fail;
  1349.         tp:=Application^.GetAddr(ATree);
  1350.         { freie Images... }
  1351.         if tp=nil then
  1352.             begin
  1353.                 inherited Done;
  1354.                 fail
  1355.             end;
  1356.         ObjTree:=ATree;
  1357.         ObjIndx:=AnIndex;
  1358.         ObjAddr:=@tp^[ObjIndx];
  1359.         if ObjAddr=nil then
  1360.             begin
  1361.                 inherited Done;
  1362.                 fail
  1363.             end;
  1364.         with ObjAddr^ do
  1365.             if (ob_type and $ff)<>G_IMAGE then
  1366.                 begin
  1367.                     inherited Done;
  1368.                     fail
  1369.                 end;
  1370.         Style:=Style or es_Icon;
  1371.         with VObj do
  1372.             begin
  1373.                 ob_next:=-1;
  1374.                 ob_head:=-1;
  1375.                 ob_tail:=-1;
  1376.                 ob_type:=G_IMAGE;
  1377.                 ob_flags:=LASTOB;
  1378.                 ob_state:=NORMAL;
  1379.                 ob_spec.bit_blk:=ObjAddr^.ob_spec.bit_blk;
  1380.                 ob_width:=ob_spec.bit_blk^.bi_wb shl 3;
  1381.                 ob_height:=ob_spec.bit_blk^.bi_hl;
  1382.                 tyrel:=ob_height+1
  1383.             end;
  1384.         ADialog:=nil;
  1385.         icontext:=nil;
  1386.         BHelp:=nil;
  1387.         Click:=0;
  1388.         Shift:=K_NORMAL;
  1389.         VStat:=K_NORMAL;
  1390.         VKey:=id_No;
  1391.         IsMovable:=Movable;
  1392.         IsSelectable:=Selectble;
  1393.         hideflag:=true;
  1394.         SetPos(iX,iY,false);
  1395.         SetText(AName);
  1396.         hideflag:=(Parent=PEventObject(Application)); { ... }
  1397.         SetHelp(Hlp)
  1398.     end;
  1399.  
  1400.  
  1401. destructor TIcon.Done;
  1402.  
  1403.     begin
  1404.         DisposeStr(icontext);
  1405.         DisposeStr(BHelp);
  1406.         inherited Done
  1407.     end;
  1408.  
  1409.  
  1410. function TIcon.TestButton(mX,mY,BStat,KStat,Clicks: integer): boolean;
  1411.     label _weiter,_move;
  1412.  
  1413.     var r: GRECT;
  1414.  
  1415.     begin
  1416.         TestButton:=false;
  1417.         if IsHidden then exit;
  1418.         r.X:=mX;
  1419.         r.Y:=mY;
  1420.         r.W:=1;
  1421.         r.H:=1;
  1422.         GRtoA2(r);
  1423.         if IsSelected(r) then
  1424.             begin
  1425.                 if BStat=1 then
  1426.                     begin
  1427.                         TestButton:=true;
  1428.                         wind_update(BEG_UPDATE);
  1429.                         if IsMovable and (Clicks=1) and ((GetCheck=bf_Checked) or not(IsSelectable)) then
  1430.                             begin
  1431.                                 _move:
  1432.                                 if Parent=PEventObject(Application) then Application^.MoveIcons(Parent,@self,DESK,mX,mY)
  1433.                                 else
  1434.                                     Application^.MoveIcons(Parent,@self,PWindow(Parent)^.Attr.gemHandle,mX,mY);
  1435.                                 goto _weiter
  1436.                             end;
  1437.                         if IsSelectable then
  1438.                             begin
  1439.                                 if (KStat and K_SHIFT)>0 then Application^.IconSelect(false,PWindow(Parent)^.Attr.gemHandle)
  1440.                                 else
  1441.                                     Application^.IconSelect(false,id_No);
  1442.                                 Toggle
  1443.                             end;
  1444.                         Click:=Clicks;
  1445.                         Shift:=KStat;
  1446.                         Work;
  1447.                         if (GetCheck=bf_Checked) and IsMovable then
  1448.                             begin
  1449.                                 evnt_timer(20,0);
  1450.                                 graf_mkstate(mX,mY,BStat,KStat);
  1451.                                 if BStat=1 then goto _move
  1452.                             end;
  1453.                         wind_update(BEG_MCTRL);
  1454.                         repeat
  1455.                             graf_mkstate(mX,mY,BStat,KStat)
  1456.                         until BStat=0;
  1457.                         wind_update(END_MCTRL);
  1458.                         _weiter:
  1459.                         wind_update(END_UPDATE)
  1460.                     end
  1461.                 else
  1462.                     if (BStat=2) and (Clicks=1) then
  1463.                         begin
  1464.                             if IsHelpAvailable then Application^.BubbleHelp(mX,mY,bbldelay,GetHelp);
  1465.                             TestButton:=true
  1466.                         end
  1467.             end
  1468.     end;
  1469.  
  1470.  
  1471. function TIcon.TestKey(Stat,Key: integer): boolean;
  1472.  
  1473.     begin
  1474.         TestKey:=false;
  1475.         if IsHidden then exit;
  1476.         if bTst(VStat,K_SHIFT) then
  1477.             if (Stat and K_SHIFT)>0 then Stat:=Stat or K_SHIFT;
  1478.         if (Stat=VStat) and (Key=VKey) then
  1479.             begin
  1480.                 TestKey:=true;
  1481.                 if IsSelectable then
  1482.                     begin
  1483.                         Application^.IconSelect(false,id_No);
  1484.                         Check
  1485.                     end;
  1486.                 Click:=0;
  1487.                 Shift:=K_NORMAL;
  1488.                 Work
  1489.             end
  1490.     end;
  1491.  
  1492.  
  1493. function TIcon.GetOutline(var IcnRect,TxtRect: GRECT): boolean;
  1494.  
  1495.     begin
  1496.         with PWindow(Parent)^ do
  1497.             begin
  1498.                 IcnRect.X:=XPos+Work.X;
  1499.                 IcnRect.Y:=YPos+Work.Y;
  1500.                 IcnRect.W:=VObj.ob_width;
  1501.                 IcnRect.H:=VObj.ob_height+1
  1502.             end;
  1503.         if icontext<>nil then
  1504.             begin
  1505.                 TxtRect.X:=IcnRect.X+txrel-1;
  1506.                 TxtRect.Y:=IcnRect.Y+tyrel-1;
  1507.                 TxtRect.W:=length(icontext^)*6+2; { ... }
  1508.                 TxtRect.H:=9; { 6+3... }
  1509.                 GetOutline:=true
  1510.             end
  1511.         else
  1512.             begin
  1513.                 TxtRect.X:=Application^.Attr.MaxPX+1;
  1514.                 TxtRect.Y:=0;
  1515.                 TxtRect.W:=1;
  1516.                 TxtRect.H:=1;
  1517.                 GetOutline:=false
  1518.             end;
  1519.         GRtoA2(IcnRect);
  1520.         GRtoA2(TxtRect)
  1521.     end;
  1522.  
  1523.  
  1524. function TIcon.IsSelected(r: GRECT): boolean;
  1525.     var s,t  : GRECT;
  1526.         valid: boolean;
  1527.  
  1528.     begin
  1529.         if IsHidden then
  1530.             begin
  1531.                 IsSelected:=false;
  1532.                 exit
  1533.             end;
  1534.         if GetOutline(s,t) then valid:=rc_intersect(r,t)
  1535.         else
  1536.             valid:=false;
  1537.         if not(valid) then valid:=rc_intersect(r,s);
  1538.         IsSelected:=valid
  1539.     end;
  1540.  
  1541.  
  1542. procedure TIcon.SetText(AName: string);
  1543.  
  1544.     begin
  1545.         RedrawParent;
  1546.         DisposeStr(icontext);
  1547.         icontext:=NewStr(AName);
  1548.         if icontext=nil then txrel:=0
  1549.         else
  1550.             txrel:=(VObj.ob_width-length(icontext^)*6) shr 1; { ... }
  1551.         Paint
  1552.     end;
  1553.  
  1554.  
  1555. function TIcon.GetText: string;
  1556.  
  1557.     begin
  1558.         if icontext=nil then GetText:=''
  1559.         else
  1560.             GetText:=icontext^
  1561.     end;
  1562.  
  1563.  
  1564. procedure TIcon.SetPos(iX,iY: integer; Redraw: boolean);
  1565.  
  1566.     begin
  1567.         if Redraw then RedrawParent;
  1568.         XPos:=iX;
  1569.         YPos:=iY;
  1570.         if Redraw then Paint
  1571.     end;
  1572.  
  1573.  
  1574. procedure TIcon.SetCheck(CheckFlag: integer);
  1575.  
  1576.     begin
  1577.         if GetCheck<>CheckFlag then
  1578.             begin
  1579.                 if CheckFlag=bf_Unchecked then VObj.ob_state:=VObj.ob_state and not(SELECTED)
  1580.                 else
  1581.                     VObj.ob_state:=VObj.ob_state or SELECTED;
  1582.                 Paint
  1583.             end
  1584.     end;
  1585.  
  1586.  
  1587. function TIcon.GetCheck: integer;
  1588.  
  1589.     begin
  1590.         if bTst(VObj.ob_state,SELECTED) then GetCheck:=bf_Checked
  1591.         else
  1592.             GetCheck:=bf_Unchecked
  1593.     end;
  1594.  
  1595.  
  1596. procedure TIcon.Check;
  1597.  
  1598.     begin
  1599.         SetCheck(bf_Checked)
  1600.     end;
  1601.  
  1602.  
  1603. procedure TIcon.Uncheck;
  1604.  
  1605.     begin
  1606.         SetCheck(bf_Unchecked)
  1607.     end;
  1608.  
  1609.  
  1610. procedure TIcon.Toggle;
  1611.  
  1612.     begin
  1613.         if GetCheck=bf_Unchecked then SetCheck(bf_Checked)
  1614.         else
  1615.             SetCheck(bf_Unchecked)
  1616.     end;
  1617.  
  1618.  
  1619. procedure TIcon.Hide(Draw: boolean);
  1620.  
  1621.     begin
  1622.         if not(IsHidden) then
  1623.             begin
  1624.                 if Draw then RedrawParent;
  1625.                 hideflag:=true
  1626.             end
  1627.     end;
  1628.  
  1629.  
  1630. procedure TIcon.Unhide;
  1631.  
  1632.     begin
  1633.         if IsHidden then
  1634.             begin
  1635.                 hideflag:=false;
  1636.                 Paint
  1637.             end
  1638.     end;
  1639.  
  1640.  
  1641. function TIcon.IsHidden: boolean;
  1642.  
  1643.     begin
  1644.         IsHidden:=hideflag
  1645.     end;
  1646.  
  1647.  
  1648. procedure TIcon.Paint;
  1649.     var valid      : boolean;
  1650.         rect       : GRECT;
  1651.         attrib,atrb: ARRAY_10;
  1652.         ipxy,tpxy  : ARRAY_4;
  1653.         dummy,tfx,
  1654.         vh,vfi,vfc,
  1655.         icnbc,txbc,
  1656.         wrm        : integer;
  1657.         dname      : string[33];
  1658.  
  1659.     begin
  1660.         if IsHidden then exit;
  1661.         if PWindow(Parent)^.Attr.Status<>ws_Open then exit;
  1662.         wind_update(BEG_UPDATE);
  1663.         with VObj do
  1664.             begin
  1665.                 ob_x:=XPos+PWindow(Parent)^.Work.X;
  1666.                 ob_y:=YPos+PWindow(Parent)^.Work.Y;
  1667.                 ob_spec.bit_blk^.bi_x:=0;
  1668.                 ob_spec.bit_blk^.bi_y:=0;
  1669.                 ipxy[0]:=ob_x;
  1670.                 ipxy[1]:=ob_y;
  1671.                 ipxy[2]:=ob_x+ob_width-1;
  1672.                 ipxy[3]:=ob_y+ob_height-1
  1673.             end;
  1674.         vh:=PWindow(Parent)^.vdiHandle;
  1675.         vqt_attributes(vh,attrib);
  1676.         tfx:=GP.teffects;
  1677.         vfi:=GP.finterior;
  1678.         vfc:=GP.fcolor;
  1679.         wrm:=GP.wrmode;
  1680.         gem.vst_font(vh,vqt_name(vh,1,dname));
  1681.         gem.vst_point(vh,8,dummy,dummy,dummy,dummy);
  1682.         gem.vst_alignment(vh,TA_LEFT,TA_TOP,dummy,dummy);
  1683.         gem.vst_color(vh,Black);
  1684.         gem.vst_rotation(vh,0);
  1685.         gem.vst_effects(vh,TF_NORMAL);
  1686.         gem.vsf_interior(vh,FIS_SOLID);
  1687.         vqt_attributes(vh,atrb);
  1688.         if icontext<>nil then
  1689.             begin
  1690.                 tpxy[0]:=XPos+PWindow(Parent)^.Work.X+txrel-1;
  1691.                 tpxy[1]:=YPos+PWindow(Parent)^.Work.Y+tyrel-1;
  1692.                 tpxy[2]:=tpxy[0]+length(icontext^)*atrb[8]+1;
  1693.                 tpxy[3]:=tpxy[1]+atrb[9]+2
  1694.             end;
  1695.         if PWindow(Parent)^.Class.hbrBackground>=1 then icnbc:=PWindow(Parent)^.Class.hbrBackground-1
  1696.         else
  1697.             icnbc:=White;
  1698.         if GetCheck=bf_Checked then txbc:=Black
  1699.         else
  1700.             txbc:=White;
  1701.         HideMouse;
  1702.         valid:=PWindow(Parent)^.FirstWorkRect(rect);
  1703.         while valid do
  1704.             begin
  1705.                 vs_clip(vh,CLIP_ON,rect.A2);
  1706.                 gem.vswr_mode(vh,MD_REPLACE);
  1707.                 gem.vsf_color(vh,icnbc);
  1708.                 vr_recfl(vh,ipxy);
  1709.                 with rect do objc_draw(@VObj,0,0,X,Y,W,H);
  1710.                 if icontext<>nil then
  1711.                     begin
  1712.                         gem.vsf_color(vh,txbc);
  1713.                         vr_recfl(vh,tpxy);
  1714.                         gem.vswr_mode(vh,MD_XOR);
  1715.                         v_gtext(vh,VObj.ob_x+txrel,VObj.ob_y+tyrel,icontext^)
  1716.                     end;
  1717.                 valid:=PWindow(Parent)^.NextWorkRect(rect)
  1718.             end;
  1719.         ShowMouse;
  1720.         gem.vsf_interior(vh,vfi);
  1721.         gem.vsf_color(vh,vfc);
  1722.         gem.vst_font(vh,attrib[0]);
  1723.         gem.vst_height(vh,attrib[7],dummy,dummy,dummy,dummy);
  1724.         gem.vst_alignment(vh,attrib[3],attrib[4],dummy,dummy);
  1725.         gem.vst_color(vh,attrib[1]);
  1726.         gem.vst_rotation(vh,attrib[2]);
  1727.          gem.vst_effects(vh,tfx);
  1728.         gem.vswr_mode(vh,wrm);
  1729.         vs_clip(vh,CLIP_ON,DRect.A2);
  1730.         wind_update(END_UPDATE)
  1731.     end;
  1732.  
  1733.  
  1734. function TIcon.IsHelpAvailable: boolean;
  1735.  
  1736.     begin
  1737.         if BHelp=nil then IsHelpAvailable:=false
  1738.         else
  1739.             IsHelpAvailable:=(length(StrPTrimF(BHelp^))<>0)
  1740.     end;
  1741.  
  1742.  
  1743. function TIcon.GetHelp: string;
  1744.  
  1745.     begin
  1746.         if BHelp<>nil then GetHelp:=BHelp^ else GetHelp:=''
  1747.     end;
  1748.  
  1749.  
  1750. procedure TIcon.SetHelp(Hlp: string);
  1751.  
  1752.     begin
  1753.         DisposeStr(BHelp);
  1754.         BHelp:=NewStr(Hlp)
  1755.     end;
  1756.  
  1757.  
  1758. procedure TIcon.IMMoved(X,Y: integer);
  1759.  
  1760.     begin
  1761.         SetPos(X,Y,true)
  1762.     end;
  1763.  
  1764.  
  1765.     { private }
  1766.  
  1767.  
  1768. procedure TIcon.RedrawParent;
  1769.     var s,t: GRECT;
  1770.  
  1771.     begin
  1772.         if IsHidden then exit;
  1773.         if Parent=PEventObject(Application) then exit; { ... }
  1774.         if GetOutline(s,t) then Application^.InvalidateRect(PWindow(Parent)^.Attr.Handle,@t);
  1775.         Application^.InvalidateRect(PWindow(Parent)^.Attr.Handle,@s)
  1776.     end;
  1777.  
  1778. { *** TICON *** }
  1779.  
  1780.  
  1781.  
  1782. { *** Objekt TCLIPBOARD *** }
  1783.  
  1784. constructor TClipboard.Init(AParent: PObject);
  1785.  
  1786.     begin
  1787.         if not(inherited Init) then fail;
  1788.         if AParent=nil then fail;
  1789.         openflag:=false;
  1790.         clippath:=nil;
  1791.         formats:=nil;
  1792.         Parent:=AParent;
  1793.         clipmask:=SCF_INDEF;
  1794.         clipext:=#0#0#0#0
  1795.     end;
  1796.  
  1797.  
  1798. function TClipboard.OpenClipboard(Write: boolean): boolean;
  1799.     label _raus,_fertig,_path;
  1800.  
  1801.     var path,test: string;
  1802.         olddta   : DTAPtr;
  1803.         newdta   : DTA;
  1804.         valid    : boolean;
  1805.  
  1806.     function setpath: boolean;
  1807.         label _weiter;
  1808.  
  1809.         begin
  1810.             setpath:=false;
  1811.             if bTst(GetDrives,4) then
  1812.                 begin
  1813.                     path:='C:\CLIPBRD';
  1814.                     if PathExist(path) then goto _weiter
  1815.                     else
  1816.                         if dcreate(path+#0)=0 then
  1817.                             if PathExist(path) then goto _weiter
  1818.                 end;
  1819.             if not(BootDevice in ['A','C']) then
  1820.                 begin
  1821.                     path:=BootDevice+':\CLIPBRD';
  1822.                     if PathExist(path) then goto _weiter
  1823.                     else
  1824.                         if dcreate(path+#0)=0 then
  1825.                             if PathExist(path) then goto _weiter
  1826.                 end;
  1827.             if bTst(GetDrives,1) then
  1828.                 begin
  1829.                     path:='A:\CLIPBRD';
  1830.                     if PathExist(path) then goto _weiter
  1831.                     else
  1832.                         if dcreate(path+#0)=0 then
  1833.                             if PathExist(path) then goto _weiter
  1834.                 end;
  1835.             exit;
  1836.             _weiter:
  1837.             path:=path+'\';
  1838.             setpath:=true;
  1839.             valid:=true
  1840.         end;
  1841.  
  1842.     begin
  1843.         OpenClipboard:=false;
  1844.         if cliplock then exit;
  1845.         if Psemaphore(2,_SCP,100)=-1 then exit;
  1846.         if not(AppFlag) then wind_update(BEG_UPDATE);
  1847.         BusyMouse;
  1848.         olddta:=fgetdta;
  1849.         fsetdta(@newdta);
  1850.         valid:=false;
  1851.         if scrp_read(path)=0 then path:='';
  1852.         StrPTrim(path);
  1853.         if length(path)=0 then
  1854.             begin
  1855.                 path:=GetEnv('CLIPBRD');
  1856.                 if length(path)=0 then path:=GetEnv('SCRAPDIR');
  1857.                 if length(path)=0 then goto _path;
  1858.                 StrPTrim(path)
  1859.             end;
  1860.         _path:
  1861.         if length(path)>0 then
  1862.             begin
  1863.                 if StrPLeft(path,1)='\' then
  1864.                     begin
  1865.                         path:=BootDevice+':'+path;
  1866.                         valid:=true
  1867.                     end;
  1868.                 if StrPRight(StrPLeft(path,2),1)<>':' then
  1869.                     begin
  1870.                         path:=BootDevice+':\'+path;
  1871.                         valid:=true
  1872.                     end;
  1873.                 if pos('\',path)>0 then
  1874.                     if RPos('\SCRAP.',StrPUpper(path))=RPos('\',path) then
  1875.                         begin
  1876.                             path:=StrPLeft(path,RPos('\',path));
  1877.                             valid:=true
  1878.                         end;
  1879.                 if StrPRight(path,1)<>'\' then
  1880.                     begin
  1881.                         path:=path+'\';
  1882.                         valid:=true
  1883.                     end;
  1884.                 if not(PathExist(path)) then
  1885.                     if not(setpath) then goto _raus
  1886.             end
  1887.         else
  1888.             if not(setpath) then goto _raus;
  1889.         if valid then
  1890.             if scrp_write(path)=0 then goto _raus;
  1891.         clippath:=NewStr(path+'SCRAP.');
  1892.         if clippath=nil then goto _raus;
  1893.         openflag:=true;
  1894.         if Write then
  1895.             if not(EmptyClipboard) then
  1896.                 begin
  1897.                     openflag:=false;
  1898.                     goto _raus
  1899.                 end;
  1900.         cliplock:=true;
  1901.         writeflag:=Write;
  1902.         OpenClipboard:=true;
  1903.         goto _fertig;
  1904.         _raus:
  1905.         ArrowMouse;
  1906.         Psemaphore(3,_SCP,0);
  1907.         _fertig:
  1908.         fsetdta(olddta);
  1909.         if not(AppFlag) then wind_update(END_UPDATE)
  1910.     end;
  1911.  
  1912.  
  1913. function TClipboard.IsOpen: boolean;
  1914.  
  1915.     begin
  1916.         IsOpen:=openflag
  1917.     end;
  1918.  
  1919.  
  1920. function TClipboard.GetClipboardFilename: string;
  1921.  
  1922.     begin
  1923.         if clippath=nil then GetClipboardFilename:=''
  1924.         else
  1925.             GetClipboardFilename:=clippath^
  1926.     end;
  1927.  
  1928.  
  1929. function TClipboard.GetPriorityClipboardFormat(PriorityList: string): string;
  1930.     var ps: integer;
  1931.  
  1932.     begin
  1933.         GetPriorityClipboardFormat:='';
  1934.         if not(IsOpen) then exit;
  1935.         PriorityList:=PriorityList+'.';
  1936.         while length(PriorityList)>0 do
  1937.             begin
  1938.                 ps:=pos('.',PriorityList);
  1939.                 if IsClipboardFormatAvailable(StrPLeft(PriorityList,ps-1)) then
  1940.                     begin
  1941.                         GetPriorityClipboardFormat:=StrPUpper(StrPLeft(PriorityList,ps-1));
  1942.                         exit
  1943.                     end;
  1944.                 PriorityList:=StrPRight(PriorityList,length(PriorityList)-ps)
  1945.             end
  1946.     end;
  1947.  
  1948.  
  1949. function TClipboard.IsClipboardFormatAvailable(Format: string): boolean;
  1950.     var olddta : DTAPtr;
  1951.         newdta : DTA;
  1952.         formate: string;
  1953.         ret    : integer;
  1954.  
  1955.     begin
  1956.         IsClipboardFormatAvailable:=false;
  1957.         if not(IsOpen) then exit;
  1958.         if formats=nil then
  1959.             begin
  1960.                 formate:='.';
  1961.                 if not(AppFlag) then wind_update(BEG_UPDATE);
  1962.                 olddta:=fgetdta;
  1963.                 fsetdta(@newdta);
  1964.                 ret:=fsfirst(clippath^+'*',FA_HIDDEN);
  1965.                 while ret=0 do
  1966.                     begin
  1967.                         if length(newdta.d_fname)>6 then formate:=StrPRight(newdta.d_fname,length(newdta.d_fname)-5)+formate;
  1968.                         ret:=fsnext
  1969.                     end;
  1970.                 fsetdta(olddta);
  1971.                 if not(AppFlag) then wind_update(END_UPDATE);
  1972.                 formats:=NewStr(StrPUpper(formate))
  1973.             end;
  1974.         if (formats=nil) or (length(Format)=0) then exit;
  1975.         if StrPLeft(Format,1)<>'.' then Format:='.'+Format;
  1976.         IsClipboardFormatAvailable:=(pos(StrPUpper(Format)+'.',formats^)>0)
  1977.     end;
  1978.  
  1979.  
  1980. function TClipboard.EmptyClipboard: boolean;
  1981.     var olddta: DTAPtr;
  1982.         newdta: DTA;
  1983.         path  : string;
  1984.         ret   : integer;
  1985.         f     : file;
  1986.  
  1987.     begin
  1988.         EmptyClipboard:=false;
  1989.         if not(IsOpen) then exit;
  1990.         if not(AppFlag) then wind_update(BEG_UPDATE);
  1991.         BusyMouse;
  1992.         path:=StrPLeft(clippath^,RPos('\',clippath^));
  1993.         olddta:=fgetdta;
  1994.         fsetdta(@newdta);
  1995.         ret:=fsfirst(clippath^+'*',FA_HIDDEN);
  1996.         while ret=0 do
  1997.             begin
  1998.                 assign(f,path+newdta.d_fname);
  1999.                 erase(f);
  2000.                 ret:=fsnext
  2001.             end;
  2002.         if fsfirst(clippath^+'*',FA_HIDDEN)<>0 then EmptyClipboard:=true;
  2003.         fsetdta(olddta);
  2004.         ArrowMouse;
  2005.         if not(AppFlag) then wind_update(END_UPDATE)
  2006.     end;
  2007.  
  2008.  
  2009. procedure TClipboard.SetClipboardFormat(Mask: word; Ext: string);
  2010.  
  2011.     begin
  2012.         if not(IsOpen) then exit;
  2013.         clipmask:=Mask;
  2014.         StrPTrim(Ext);
  2015.         if StrPLeft(Ext,1)<>'.' then Ext:='.'+Ext;
  2016.         clipext:=StrPLeft(Ext,4);
  2017.         while length(clipext)<4 do clipext:=clipext+#0;
  2018.         writeflag:=true
  2019.     end;
  2020.  
  2021.  
  2022. function TClipboard.CloseClipboard: boolean;
  2023.     var pipe: Pipearray;
  2024.  
  2025.     begin
  2026.         CloseClipboard:=false;
  2027.         if not(IsOpen) then exit;
  2028.         cliplock:=false;
  2029.         openflag:=false;
  2030.         Psemaphore(3,_SCP,0);
  2031.         CloseClipboard:=true;
  2032.         DisposeStr(clippath);
  2033.         DisposeStr(formats);
  2034.         ArrowMouse;
  2035.         if writeflag then
  2036.             begin
  2037.                 pipe[0]:=SC_CHANGED;
  2038.                 pipe[3]:=integer(clipmask);
  2039.                 pipe[4]:=integer((ord(clipext[1]) shl 8)+ord(clipext[2]));
  2040.                 pipe[5]:=integer((ord(clipext[3]) shl 8)+ord(clipext[4]));
  2041.                 pipe[6]:=0;
  2042.                 pipe[7]:=0;
  2043.                 Application^.Broadcast(@pipe,true)
  2044.             end;
  2045.         clipext:=#0#0#0#0;
  2046.         clipmask:=SCF_INDEF
  2047.     end;
  2048.  
  2049. { *** TCLIPBOARD *** }
  2050.  
  2051.  
  2052.  
  2053. { *** Objekt TCONTROL *** }
  2054.  
  2055. constructor TControl.Init(AParent: PDialog; AnIndx: integer; Hlp: string);
  2056.     var p: PControl;
  2057.  
  2058.     begin
  2059.         if not(inherited Init) then fail;
  2060.         Parent:=AParent;
  2061.         if Parent=nil then
  2062.             begin
  2063.                 inherited Done;
  2064.                 fail
  2065.             end;
  2066.         ObjIndx:=AnIndx;
  2067.         ObjAddr:=@Parent^.DlgTree^[ObjIndx];
  2068.         if ObjAddr=nil then
  2069.             begin
  2070.                 inherited Done;
  2071.                 fail
  2072.             end;
  2073.         BHelp:=nil;
  2074.         SetHelp(Hlp);
  2075.         ID:=id_No;
  2076.         Style:=0;
  2077.         Flags:=0;
  2078.         Prev:=nil;
  2079.         Nxt:=nil;
  2080.         SetShortCut(#0);
  2081.         UsrDef:=false;
  2082.         UsrBlk.ub_code:=nil;
  2083.         UsrBlk.ub_parm:=0;
  2084.         if Parent^.CtrlList=nil then Parent^.CtrlList:=@self
  2085.         else
  2086.             begin
  2087.                 p:=Parent^.CtrlList;
  2088.                 while p^.Nxt<>nil do p:=p^.Nxt;
  2089.                 p^.Nxt:=@self;
  2090.                 Prev:=p
  2091.             end
  2092.     end;
  2093.  
  2094.  
  2095. destructor TControl.Done;
  2096.  
  2097.     begin
  2098.         if (Prev=nil) and (Nxt=nil) then Parent^.CtrlList:=nil
  2099.         else
  2100.             begin
  2101.                 if Prev=nil then Parent^.CtrlList:=Nxt
  2102.                     else Prev^.Nxt:=Nxt;
  2103.                 if Nxt<>nil then Nxt^.Prev:=Prev
  2104.             end;
  2105.         DisposeStr(BHelp);
  2106.         inherited Done
  2107.     end;
  2108.  
  2109.  
  2110. function TControl.TestIndex(AnIndx: integer): boolean;
  2111.  
  2112.     begin
  2113.         TestIndex:=(AnIndx=ObjIndx)
  2114.     end;
  2115.  
  2116.  
  2117. function TControl.TestID(AnID: integer): boolean;
  2118.  
  2119.     begin
  2120.         TestID:=(AnID=ID)
  2121.     end;
  2122.  
  2123.  
  2124. function TControl.TestShortCut(Key: integer): boolean;
  2125.  
  2126.     begin
  2127.         TestShortCut:=(Key=shortcut)
  2128.     end;
  2129.  
  2130.  
  2131. procedure TControl.SetShortCut(Key: char);
  2132.  
  2133.     begin
  2134.         if Key=#0 then shortcut:=id_No
  2135.         else
  2136.             shortcut:=ord(upcase(Key))
  2137.     end;
  2138.  
  2139.  
  2140. procedure TControl.SetFlags(Mask: byte; OnOff: boolean);
  2141.  
  2142.     begin
  2143.         if OnOff then Flags:=Flags or Mask
  2144.         else
  2145.             Flags:=Flags and not(Mask)
  2146.     end;
  2147.  
  2148.  
  2149. function TControl.IsFlagSet(Mask: byte): boolean;
  2150.  
  2151.     begin
  2152.         IsFlagSet:=bTst(Flags,Mask)
  2153.     end;
  2154.  
  2155.  
  2156. procedure TControl.SetState(StateFlag: integer);
  2157.  
  2158.     begin
  2159.         if GetState<>StateFlag then
  2160.             begin
  2161.                 with ObjAddr^ do
  2162.                     if StateFlag=bf_Disabled then
  2163.                         ob_state:=ob_state or DISABLED
  2164.                     else
  2165.                         ob_state:=ob_state and not(DISABLED);
  2166.                 Paint
  2167.             end
  2168.     end;
  2169.  
  2170.  
  2171. function TControl.GetState: integer;
  2172.  
  2173.     begin
  2174.         if bTst(ObjAddr^.ob_state,DISABLED) then GetState:=bf_Disabled
  2175.         else
  2176.             GetState:=bf_Enabled
  2177.     end;
  2178.  
  2179.  
  2180. procedure TControl.Disable;
  2181.  
  2182.     begin
  2183.         SetState(bf_Disabled)
  2184.     end;
  2185.  
  2186.  
  2187. procedure TControl.Enable;
  2188.  
  2189.     begin
  2190.         SetState(bf_Enabled)
  2191.     end;
  2192.  
  2193.  
  2194. procedure TControl.SetColor(Color: integer);
  2195.     var ot: integer;
  2196.  
  2197.     begin
  2198.         if (Color<0) or (Color>15) then Color:=Black;
  2199.         if Color<>GetColor then
  2200.             begin
  2201.                 ot:=ObjAddr^.ob_type and $ff;
  2202.                 with ObjAddr^.ob_spec do
  2203.                     begin
  2204.                         if ot in [G_BOX,G_IBOX,G_BOXCHAR] then index:=(index and $fffff0ff) or (Color shl 8)
  2205.                         else
  2206.                             if ot in [G_TEXT,G_BOXTEXT,G_FTEXT,G_FBOXTEXT] then ted_info^.te_color:=(ted_info^.te_color and $f0ff) or (Color shl 8)
  2207.                             else
  2208.                                 if ot=G_ICON then icon_blk^.ib_char:=(icon_blk^.ib_char and $f0ff) or (Color shl 8)
  2209.                                 else
  2210.                                     if ot=G_IMAGE then bit_blk^.bi_color:=Color
  2211.                     end;
  2212.                 Paint
  2213.             end
  2214.     end;
  2215.  
  2216.  
  2217. function TControl.GetColor: integer;
  2218.     var ot: integer;
  2219.  
  2220.     begin
  2221.         GetColor:=Black;
  2222.         ot:=ObjAddr^.ob_type and $ff;
  2223.         if ot in [G_BOX,G_IBOX,G_BOXCHAR] then GetColor:=(ObjAddr^.ob_spec.index shr 8) and $0f
  2224.         else
  2225.             if ot in [G_TEXT,G_BOXTEXT,G_FTEXT,G_FBOXTEXT] then GetColor:=(ObjAddr^.ob_spec.ted_info^.te_color shr 8) and $0f
  2226.             else
  2227.                 if ot=G_ICON then GetColor:=(ObjAddr^.ob_spec.icon_blk^.ib_char shr 8) and $0f
  2228.                 else
  2229.                     if ot=G_IMAGE then GetColor:=ObjAddr^.ob_spec.bit_blk^.bi_color
  2230.     end;
  2231.  
  2232.  
  2233. procedure TControl.Hide(Draw: boolean);
  2234.  
  2235.     begin
  2236.         if not(IsHidden) then
  2237.             begin
  2238.                 with ObjAddr^ do ob_flags:=ob_flags or HIDETREE;
  2239.                 if Draw then
  2240.                     Parent^.ObjcPaint(Application^.GetObjectParent(Parent^.DlgTree,ObjIndx),bTst(Flags,wb_Lazy))
  2241.             end
  2242.     end;
  2243.  
  2244.  
  2245. procedure TControl.Unhide;
  2246.  
  2247.     begin
  2248.         if IsHidden then
  2249.             begin
  2250.                 with ObjAddr^ do ob_flags:=ob_flags and not(HIDETREE);
  2251.                 Paint
  2252.             end
  2253.     end;
  2254.  
  2255.  
  2256. function TControl.IsHidden: boolean;
  2257.  
  2258.     begin
  2259.         IsHidden:=bTst(ObjAddr^.ob_flags,HIDETREE)
  2260.     end;
  2261.  
  2262.  
  2263. procedure TControl.DisableTransfer;
  2264.  
  2265.     begin
  2266.         SetFlags(wb_Transfer,false)
  2267.     end;
  2268.  
  2269.  
  2270. procedure TControl.EnableTransfer;
  2271.  
  2272.     begin
  2273.         SetFlags(wb_Transfer,true)
  2274.     end;
  2275.  
  2276.  
  2277. function TControl.Transfer(DataPtr: pointer; TransferFlag: word): word;
  2278.  
  2279.     begin
  2280.         Transfer:=0
  2281.     end;
  2282.  
  2283.  
  2284. procedure TControl.Changed(AnIndx: integer; DblClick: boolean);
  2285.  
  2286.     begin
  2287.     end;
  2288.  
  2289.  
  2290. procedure TControl.Paint;
  2291.  
  2292.     begin
  2293.         Parent^.ObjcPaint(ObjIndx,bTst(Flags,wb_Lazy))
  2294.     end;
  2295.  
  2296.  
  2297. function TControl.IsHelpAvailable: boolean;
  2298.  
  2299.     begin
  2300.         if BHelp=nil then IsHelpAvailable:=false
  2301.         else
  2302.             IsHelpAvailable:=(length(StrPTrimF(BHelp^))<>0)
  2303.     end;
  2304.  
  2305.  
  2306. function TControl.GetHelp: string;
  2307.  
  2308.     begin
  2309.         if BHelp<>nil then GetHelp:=BHelp^ else GetHelp:=''
  2310.     end;
  2311.  
  2312.  
  2313. procedure TControl.SetHelp(Hlp: string);
  2314.  
  2315.     begin
  2316.         DisposeStr(BHelp);
  2317.         BHelp:=NewStr(Hlp)
  2318.     end;
  2319.  
  2320.  
  2321. function TControl.Previous: PControl;
  2322.  
  2323.     begin
  2324.         Previous:=Prev
  2325.     end;
  2326.  
  2327.  
  2328. function TControl.Next: PControl;
  2329.  
  2330.     begin
  2331.         Next:=Nxt
  2332.     end;
  2333.  
  2334. { *** TCONTROL *** }
  2335.  
  2336.  
  2337.  
  2338. { *** Objekt TBUTTON *** }
  2339.  
  2340. constructor TButton.Init(AParent: PDialog; AnIndx,AnID: integer; UserDef: boolean; Hlp: string);
  2341.  
  2342.     begin
  2343.         if not(inherited Init(AParent,AnIndx,Hlp)) then fail;
  2344.         Style:=cs_PushButton;
  2345.         with ObjAddr^ do
  2346.             begin
  2347.                 if bTst(ob_flags,DEFAULT) then Style:=Style or bs_DefPushButton;
  2348.                 ID:=AnID;
  2349.                 UsrDef:=UserDef;
  2350.                 if UsrDef then
  2351.                     begin
  2352.                         oldflags:=ob_flags;
  2353.                         oldstate:=ob_state;
  2354.                         if not(Install) then
  2355.                             begin
  2356.                                 inherited Done;
  2357.                                 fail
  2358.                             end
  2359.                     end;
  2360.                 if not(UsrDef) then
  2361.                     if (ID>=id_OK) and (ID<=id_Esc) then
  2362.                         if (ob_type and $ff)=G_BOXTEXT then
  2363.                             if Application^.Attr.Colors>=Yellow then
  2364.                                 with ob_spec.ted_info^ do
  2365.                                     te_color:=(te_color and $ff00) or $70 or Yellow;
  2366.                 SetText(GetRawText)
  2367.             end
  2368.     end;
  2369.  
  2370.  
  2371. destructor TButton.Done;
  2372.  
  2373.     begin
  2374.         if UsrDef then
  2375.             begin
  2376.                 Deinstall;
  2377.                 with ObjAddr^ do
  2378.                     begin
  2379.                         ob_spec.index:=UsrBlk.ub_parm;
  2380.                         ob_type:=G_BUTTON;
  2381.                         ob_state:=oldstate;
  2382.                         ob_flags:=oldflags
  2383.                     end
  2384.             end;
  2385.         inherited Done
  2386.     end;
  2387.  
  2388.  
  2389. function TButton.Install: boolean;
  2390.  
  2391.     begin
  2392.         with ObjAddr^ do
  2393.             if (ob_type and $ff)=G_BUTTON then
  2394.                 begin
  2395.                     UsrBlk.ub_parm:=ob_spec.index;
  2396.                     UsrBlk.ub_code:=@DrawPushButton;
  2397.                     ob_flags:=(ob_flags and not(RBUTTON or EDITABLE)) or SELECTABLE;
  2398.                     ob_state:=ob_state and not(CROSSED or CHECKED or OUTLINED or SHADOWED);
  2399.                     ob_type:=G_USERDEF;
  2400.                     ob_spec.user_blk:=@UsrBlk;
  2401.                     dec(ob_x,5);
  2402.                     dec(ob_y,5);
  2403.                     inc(ob_width,10);
  2404.                     inc(ob_height,10)
  2405.                 end
  2406.             else
  2407.                 UsrDef:=false;
  2408.         Install:=true
  2409.     end;
  2410.  
  2411.  
  2412. procedure TButton.Deinstall;
  2413.  
  2414.     begin
  2415.         with ObjAddr^ do
  2416.             begin
  2417.                 inc(ob_x,5);
  2418.                 inc(ob_y,5);
  2419.                 dec(ob_width,10);
  2420.                 dec(ob_height,10)
  2421.             end
  2422.     end;
  2423.  
  2424.  
  2425. procedure TButton.SetText(ATextString: string);
  2426.     var typ,scpos: integer;
  2427.         adr      : PChar;
  2428.  
  2429.     begin
  2430.         adr:=nil;
  2431.         typ:=ObjAddr^.ob_type and $ff;
  2432.         scpos:=pos('&',ATextString);
  2433.         if (scpos>0) and (scpos<length(ATextString)) then
  2434.             begin
  2435.                 SetShortCut(ATextString[scpos+1]);
  2436.                 if not(UsrDef) then
  2437.                     ATextString:=StrPLeft(ATextString,scpos-1)+StrPRight(ATextString,length(ATextString)-scpos)
  2438.             end
  2439.         else
  2440.             SetShortCut(#0);
  2441.         if UsrDef then adr:=PChar(UsrBlk.ub_parm)
  2442.         else
  2443.             if (typ=G_BUTTON) or (typ=G_STRING) or (typ=G_TITLE) then
  2444.                 adr:=ObjAddr^.ob_spec.free_string;
  2445.         if adr<>nil then StrPCopy(adr,ATextString)
  2446.         else
  2447.             if (typ=G_TEXT) or (typ=G_BOXTEXT) or (typ=G_FTEXT) or (typ=G_FBOXTEXT) then
  2448.                 StrPCopy(ObjAddr^.ob_spec.ted_info^.te_ptext,ATextString);
  2449.         Paint
  2450.     end;
  2451.  
  2452.  
  2453. function TButton.GetText: string;
  2454.     var scpos: integer;
  2455.         txt  : string;
  2456.  
  2457.     begin
  2458.         txt:=GetRawText;
  2459.         scpos:=pos('&',txt);
  2460.         if scpos>0 then
  2461.             txt:=StrPLeft(txt,scpos-1)+StrPRight(txt,length(txt)-scpos);
  2462.         GetText:=txt
  2463.     end;
  2464.  
  2465.  
  2466.     { private }
  2467.  
  2468.  
  2469. function TButton.GetRawText: string;
  2470.     var typ: integer;
  2471.  
  2472.     begin
  2473.         if UsrDef then GetRawText:=StrPas(PChar(UsrBlk.ub_parm))
  2474.         else
  2475.             begin
  2476.                 typ:=ObjAddr^.ob_type and $ff;
  2477.                 if (typ=G_BUTTON) or (typ=G_STRING) or (typ=G_TITLE) then
  2478.                     GetRawText:=StrPas(ObjAddr^.ob_spec.free_string)
  2479.                 else
  2480.                     if (typ=G_TEXT) or (typ=G_BOXTEXT) or (typ=G_FTEXT) or (typ=G_FBOXTEXT) then
  2481.                         GetRawText:=StrPas(ObjAddr^.ob_spec.ted_info^.te_ptext)
  2482.                     else
  2483.                         GetRawText:=''
  2484.             end
  2485.     end;
  2486.  
  2487. { *** TBUTTON *** }
  2488.  
  2489.  
  2490.  
  2491. { *** Objekt TSTATIC *** }
  2492.  
  2493. constructor TStatic.Init(AParent: PDialog; AnIndx,ATextLen: integer; UserDef: boolean; Hlp: string);
  2494.  
  2495.     begin
  2496.         if not(inherited Init(AParent,AnIndx,Hlp)) then fail;
  2497.         Style:=cs_Static or sts_Fill;
  2498.         UsrDef:=false;
  2499.         usrused:=false;
  2500.         TextLen:=ATextLen;
  2501.         if TextLen>256 then TextLen:=256;
  2502.         with ObjAddr^ do
  2503.             begin
  2504.                 oldtype:=ob_type and $ff;
  2505.                 oldflags:=ob_flags;
  2506.                 ob_flags:=ob_flags and not(RBUTTON or EDITABLE or SELECTABLE or DEFAULT or F_EXIT or TOUCHEXIT);
  2507.                 if (oldtype=G_BUTTON) or (oldtype=G_STRING) or (oldtype=G_TITLE) then
  2508.                     begin
  2509.                         if TextLen<0 then TextLen:=0;
  2510.                         UsrBlk.ub_parm:=ob_spec.index;
  2511.                         if UserDef=true then
  2512.                             begin
  2513.                                 UsrDef:=true;
  2514.                                 UsrBlk.ub_code:=@DrawTitle
  2515.                             end
  2516.                         else
  2517.                             begin
  2518.                                 usrused:=true;
  2519.                                 UsrBlk.ub_code:=@DrawStatic
  2520.                             end;
  2521.                         ob_type:=G_USERDEF;
  2522.                         ob_spec.user_blk:=@UsrBlk
  2523.                     end
  2524.                 else
  2525.                     if (oldtype<>G_TEXT) and (oldtype<>G_BOXTEXT) and (oldtype<>G_FTEXT) and (oldtype<>G_FBOXTEXT) then
  2526.                         begin
  2527.                             ob_flags:=oldflags;
  2528.                             inherited Done;
  2529.                             fail
  2530.                         end
  2531.                     else
  2532.                         begin
  2533.                             if TextLen<0 then TextLen:=256;
  2534.                             if TextLen>ob_spec.ted_info^.te_txtlen then TextLen:=ob_spec.ted_info^.te_txtlen
  2535.                         end
  2536.             end
  2537.     end;
  2538.  
  2539.  
  2540. destructor TStatic.Done;
  2541.  
  2542.     begin
  2543.         with ObjAddr^ do
  2544.             begin
  2545.                 if UsrDef or usrused then
  2546.                     begin
  2547.                         ob_spec.index:=UsrBlk.ub_parm;
  2548.                         ob_type:=oldtype;
  2549.                     end;
  2550.                 ob_flags:=oldflags;
  2551.             end;
  2552.         inherited Done
  2553.     end;
  2554.  
  2555.  
  2556. function TStatic.Transfer(DataPtr: pointer; TransferFlag: word): word;
  2557.     var txt: string;
  2558.  
  2559.     begin
  2560.         case TransferFlag of
  2561.             tf_SetData: SetText(PString(DataPtr)^);
  2562.             tf_GetData: PString(DataPtr)^:=GetText
  2563.         end;
  2564.         if odd(TextLen) then Transfer:=TextLen+1
  2565.         else
  2566.             Transfer:=TextLen
  2567.     end;
  2568.  
  2569.  
  2570. procedure TStatic.SetText(ATextString: string);
  2571.     var adr: PChar;
  2572.  
  2573.     begin
  2574.         adr:=nil;
  2575.         if length(ATextString)>=TextLen then
  2576.             ATextString:=StrPLeft(ATextString,TextLen-1)
  2577.         else
  2578.             if bTst(Style,sts_Fill) then
  2579.                 ATextString:=ATextString+StrPSpace(TextLen-length(ATextString)-1);
  2580.         if UsrDef or usrused then adr:=PChar(UsrBlk.ub_parm)
  2581.         else
  2582.             if (oldtype=G_BUTTON) or (oldtype=G_STRING) or (oldtype=G_TITLE) then
  2583.                 adr:=ObjAddr^.ob_spec.free_string;
  2584.         if adr<>nil then StrPCopy(adr,ATextString)
  2585.         else
  2586.             begin
  2587.                 if ATextString[1]='@' then
  2588.                     begin
  2589.                         if bTst(Style,sts_Fill) then ATextString:=StrPSpace(TextLen-1)
  2590.                         else
  2591.                             ATextString:=''
  2592.                     end;
  2593.                 StrPCopy(ObjAddr^.ob_spec.ted_info^.te_ptext,ATextString)
  2594.             end;
  2595.         Paint
  2596.     end;
  2597.  
  2598.  
  2599. function TStatic.GetText: string;
  2600.     var txt: string;
  2601.  
  2602.     begin
  2603.         if UsrDef or usrused then txt:=StrPas(PChar(UsrBlk.ub_parm))
  2604.         else
  2605.             if (oldtype=G_BUTTON) or (oldtype=G_STRING) or (oldtype=G_TITLE) then
  2606.                 txt:=StrPas(ObjAddr^.ob_spec.free_string)
  2607.             else
  2608.                 begin
  2609.                     txt:=StrPas(ObjAddr^.ob_spec.ted_info^.te_ptext);
  2610.                     if txt[1]='@' then txt:=''
  2611.                 end;
  2612.         GetText:=StrPLeft(txt,TextLen-1)
  2613.     end;
  2614.  
  2615.  
  2616. function TStatic.GetTextLen: integer;
  2617.  
  2618.     begin
  2619.         GetTextLen:=length(GetText)
  2620.     end;
  2621.  
  2622.  
  2623. procedure TStatic.Clear;
  2624.  
  2625.     begin
  2626.         if bTst(Style,sts_Fill) then
  2627.             begin
  2628.                 if UsrDef or usrused then StrPCopy(PChar(UsrBlk.ub_parm),StrPSpace(TextLen-1))
  2629.                 else
  2630.                     if (oldtype=G_BUTTON) or (oldtype=G_STRING) or (oldtype=G_TITLE) then
  2631.                         StrPCopy(ObjAddr^.ob_spec.free_string,StrPSpace(TextLen-1))
  2632.                     else
  2633.                         setptext(Parent^.DlgTree,ObjIndx,StrPSpace(TextLen-1))
  2634.             end
  2635.         else
  2636.             begin
  2637.                 if UsrDef or usrused then PChar(UsrBlk.ub_parm)^:=#0
  2638.                 else
  2639.                     if (oldtype=G_BUTTON) or (oldtype=G_STRING) or (oldtype=G_TITLE) then
  2640.                         PChar(ObjAddr^.ob_spec.free_string)^:=#0
  2641.                     else
  2642.                         setptext(Parent^.DlgTree,ObjIndx,'')
  2643.             end;
  2644.         Paint
  2645.     end;
  2646.  
  2647. { *** TSTATIC *** }
  2648.  
  2649.  
  2650.  
  2651. { *** Objekt TEDIT *** }
  2652.  
  2653. constructor TEdit.Init(AParent: PDialog; AnIndx,ATextLen: integer; Hlp: string);
  2654.  
  2655.     begin
  2656.         if not(inherited Init(AParent,AnIndx,ATextLen,false,Hlp)) then fail;
  2657.         EnableTransfer;
  2658.         Style:=cs_Edit or es_Undo;
  2659.         if ((oldtype<>G_FTEXT) and (oldtype<>G_FBOXTEXT)) or (TextLen<2) then
  2660.             begin
  2661.                 inherited Done;
  2662.                 fail
  2663.             end;
  2664.         with ObjAddr^ do
  2665.             begin
  2666.                 ob_flags:=ob_flags or EDITABLE;
  2667.                 if bTst(Application^.Attr.Style,as_3DFlags) then ob_flags:=ob_flags or FL3DBAK
  2668.                 else
  2669.                     ob_flags:=ob_flags and not(FL3DBAK)
  2670.             end;
  2671.         Validator:=nil;
  2672.         Clipboard:=GetClipboard;
  2673.         UPtr:=nil;
  2674.         TPtr:=ChrNew(GetText);
  2675.         ClearModify;
  2676.         EdIdx:=id_No
  2677.     end;
  2678.  
  2679.  
  2680. destructor TEdit.Done;
  2681.  
  2682.     begin
  2683.         ChrDispose(TPtr);
  2684.         ChrDispose(UPtr);
  2685.         SetValidator(nil);
  2686.         if Clipboard<>nil then
  2687.             if Clipboard^.Parent=@self then dispose(Clipboard,Done);
  2688.         inherited Done
  2689.     end;
  2690.  
  2691.  
  2692. procedure TEdit.SetState(StateFlag: integer);
  2693.     var dummy: integer;
  2694.         valid: boolean;
  2695.  
  2696.     begin
  2697.         valid:=(StateFlag=bf_Disabled) and (GetState<>StateFlag) and not(Parent^.obedflag) and (Parent^.GetFocus=ObjIndx);
  2698.         if valid then
  2699.             begin
  2700.                 Parent^.objc_edit(dummy,EDEND,Parent^.Work.A2,true);
  2701.                 Parent^.edit_obj:=0
  2702.             end;
  2703.         inherited SetState(StateFlag);
  2704.         if valid then Parent^.InitFocus
  2705.     end;
  2706.  
  2707.  
  2708. procedure TEdit.SetText(ATextString: string);
  2709.     var dummy: integer;
  2710.  
  2711.     begin
  2712.         if not(Parent^.obedflag) then
  2713.             if Parent^.GetFocus=ObjIndx then
  2714.                 Parent^.objc_edit(dummy,EDEND,Parent^.Work.A2,true);
  2715.         inherited SetText(ATextString);
  2716.         if not(Parent^.obedflag) then
  2717.             if Parent^.GetFocus=ObjIndx then
  2718.                 Parent^.objc_edit(dummy,EDINIT,Parent^.Work.A2,true);
  2719.         ChrDispose(UPtr);
  2720.         UPtr:=TPtr;
  2721.         TPtr:=ChrNew(GetText);
  2722.         modified:=true
  2723.     end;
  2724.  
  2725.  
  2726. procedure TEdit.SetColor(Color: integer);
  2727.     var dummy: integer;
  2728.  
  2729.     begin
  2730.         if not(Parent^.obedflag) then
  2731.             if Parent^.GetFocus=ObjIndx then
  2732.                 Parent^.objc_edit(dummy,EDEND,Parent^.Work.A2,true);
  2733.         inherited SetColor(Color);
  2734.         if not(Parent^.obedflag) then
  2735.             if Parent^.GetFocus=ObjIndx then
  2736.                 Parent^.objc_edit(dummy,EDINIT,Parent^.Work.A2,true)
  2737.     end;
  2738.  
  2739.  
  2740. procedure TEdit.Paint;
  2741.     var dummy: integer;
  2742.  
  2743.     begin
  2744.         if not(Parent^.obedflag) then
  2745.             if Parent^.GetFocus=ObjIndx then
  2746.                 Parent^.objc_edit(dummy,EDEND,Parent^.Work.A2,true);
  2747.         inherited Paint;
  2748.         if not(Parent^.obedflag) then
  2749.             if Parent^.GetFocus=ObjIndx then
  2750.                 Parent^.objc_edit(dummy,EDINIT,Parent^.Work.A2,true)
  2751.     end;
  2752.  
  2753.  
  2754. procedure TEdit.Clear;
  2755.     var dummy: integer;
  2756.  
  2757.     begin
  2758.         if not(Parent^.obedflag) then
  2759.             if Parent^.GetFocus=ObjIndx then
  2760.                 Parent^.objc_edit(dummy,EDEND,Parent^.Work.A2,true);
  2761.         inherited Clear;
  2762.         if not(Parent^.obedflag) then
  2763.             if Parent^.GetFocus=ObjIndx then
  2764.                 Parent^.objc_edit(dummy,EDINIT,Parent^.Work.A2,true)
  2765.     end;
  2766.  
  2767.  
  2768. procedure TEdit.Edit;
  2769.     var valid     : boolean;
  2770.         old,cr,crc: string;
  2771.  
  2772.     begin
  2773.         valid:=true;
  2774.         if Validator<>nil then
  2775.             if bTst(Validator^.Options,voOnEdit) then
  2776.                 begin
  2777.                     old:=StrPas(TPtr);
  2778.                     cr:=GetText;
  2779.                     crc:=cr;
  2780.                     if not(Validator^.IsValidInput(cr,false)) then
  2781.                         begin
  2782.                             inherited SetText(old);
  2783.                             valid:=false
  2784.                         end
  2785.                     else
  2786.                         if crc<>cr then TStatic.SetText(cr)
  2787.                 end;
  2788.         if valid then
  2789.             begin
  2790.                 ChrDispose(UPtr);
  2791.                 UPtr:=TPtr;
  2792.                 TPtr:=ChrNew(GetText);
  2793.                 modified:=true
  2794.             end
  2795.     end;
  2796.  
  2797.  
  2798. function TEdit.IsValid(ReportError: boolean): boolean;
  2799.  
  2800.     begin
  2801.         if Validator<>nil then
  2802.             begin
  2803.                 if ReportError then IsValid:=Validator^.Valid(GetText)
  2804.                 else
  2805.                     IsValid:=Validator^.IsValid(GetText)
  2806.             end
  2807.         else
  2808.             IsValid:=true
  2809.     end;
  2810.  
  2811.  
  2812. function TEdit.CanClose: boolean;
  2813.  
  2814.     begin
  2815.         CanClose:=true;
  2816.         if GetState<>bf_Disabled then
  2817.             if not(IsValid(true)) then
  2818.                 begin
  2819.                     CanClose:=false;
  2820.                     Focus
  2821.                 end
  2822.     end;
  2823.  
  2824.  
  2825. function TEdit.CanUndo: boolean;
  2826.  
  2827.     begin
  2828.         CanUndo:=(UPtr<>nil) and bTst(Style,es_Undo)
  2829.     end;
  2830.  
  2831.  
  2832. procedure TEdit.Undo;
  2833.  
  2834.     begin
  2835.         if UPtr<>nil then SetText(StrLPas(UPtr,TextLen-1))
  2836.     end;
  2837.  
  2838.  
  2839. procedure TEdit.Paste;
  2840.     var f        : text;
  2841.         txt      : string;
  2842.         q,key,cnt: integer;
  2843.  
  2844.     begin
  2845.         if Clipboard=nil then exit;
  2846.         with Clipboard^ do
  2847.             begin
  2848.                 if not(OpenClipboard(false)) then exit;
  2849.                 txt:='';
  2850.                 if IsClipboardFormatAvailable('TXT') then
  2851.                     begin
  2852.                         assign(f,GetClipboardFilename+'TXT');
  2853.                         reset(f);
  2854.                         readln(f,txt);
  2855.                         close(f)
  2856.                     end;
  2857.                 CloseClipboard
  2858.             end;
  2859.         if length(txt)=0 then exit;
  2860.         cnt:=TextLen-1;
  2861.         if cnt<1 then exit;
  2862.         wind_update(BEG_UPDATE);
  2863.         HideMouse;
  2864.         for q:=1 to length(txt) do
  2865.             if not(txt[q] in [#8,#9,#10,#13,#27]) then
  2866.                 begin
  2867.                     key:=ord(txt[q]);
  2868.                     Parent^.objc_edit(key,EDCHAR,Parent^.Work.A2,true);
  2869.                     if key=0 then
  2870.                         begin
  2871.                             dec(cnt);
  2872.                             if cnt=0 then break
  2873.                         end
  2874.                 end;
  2875.         ShowMouse;
  2876.         wind_update(END_UPDATE)
  2877.     end;
  2878.  
  2879.  
  2880. procedure TEdit.Copy;
  2881.     var f: text;
  2882.  
  2883.     begin
  2884.         if Clipboard=nil then exit;
  2885.         if length(GetText)=0 then exit;
  2886.         with Clipboard^ do
  2887.             begin
  2888.                 if not(OpenClipboard(true)) then exit;
  2889.                 assign(f,GetClipboardFilename+'TXT');
  2890.                 rewrite(f);
  2891.                 if ioresult=0 then
  2892.                     begin
  2893.                         writeln(f,GetText);
  2894.                         close(f);
  2895.                         SetClipboardFormat(SCF_TEXT,'.TXT')
  2896.                     end;
  2897.                 CloseClipboard
  2898.             end
  2899.     end;
  2900.  
  2901.  
  2902. procedure TEdit.Cut;
  2903.     var f: text;
  2904.  
  2905.     begin
  2906.         if Clipboard=nil then exit;
  2907.         if length(GetText)=0 then exit;
  2908.         with Clipboard^ do
  2909.             begin
  2910.                 if not(OpenClipboard(true)) then exit;
  2911.                 assign(f,GetClipboardFilename+'TXT');
  2912.                 rewrite(f);
  2913.                 if ioresult=0 then
  2914.                     begin
  2915.                         writeln(f,GetText);
  2916.                         close(f);
  2917.                         if ioresult=0 then Clear;
  2918.                         SetClipboardFormat(SCF_TEXT,'.TXT')
  2919.                     end;
  2920.                 CloseClipboard
  2921.             end
  2922.     end;
  2923.  
  2924.  
  2925. procedure TEdit.Focus;
  2926.  
  2927.     begin
  2928.         Parent^.SetFocus(ObjIndx)
  2929.     end;
  2930.  
  2931.  
  2932. function TEdit.IsModified: boolean;
  2933.  
  2934.     begin
  2935.         IsModified:=modified
  2936.     end;
  2937.  
  2938.  
  2939. procedure TEdit.ClearModify;
  2940.  
  2941.     begin
  2942.         modified:=false
  2943.     end;
  2944.  
  2945.  
  2946. procedure TEdit.SetValidator(AValid: PValidator);
  2947.  
  2948.     begin
  2949.         if Validator<>nil then Validator^.Free;
  2950.         Validator:=AValid;
  2951.         if Validator<>nil then Validator^.Window:=Parent
  2952.     end;
  2953.  
  2954.  
  2955. procedure TEdit.SetCursor(CPos: integer);
  2956.     var maxidx: integer;
  2957.  
  2958.     begin
  2959.         maxidx:=StrLen(ObjAddr^.ob_spec.ted_info^.te_ptext);
  2960.         if (CPos<0) or (CPos>maxidx) then CPos:=maxidx;
  2961.         EdIdx:=CPos;
  2962.         with Parent^ do
  2963.             if GetFocus=ObjIndx then
  2964.                 if Attr.Status=ws_Open then
  2965.                     objc_edit(EdIdx,EDIDXABS,Work.A2,true)
  2966.     end;
  2967.  
  2968.  
  2969. function TEdit.GetCursor: integer;
  2970.  
  2971.     begin
  2972.         GetCursor:=EdIdx
  2973.     end;
  2974.  
  2975.  
  2976. function TEdit.GetClipboard: PClipboard;
  2977.  
  2978.     begin
  2979.         GetClipboard:=Parent^.Clipboard
  2980.     end;
  2981.  
  2982. { *** TEDIT *** }
  2983.  
  2984.  
  2985.  
  2986. { *** Objekt TPOPUP *** }
  2987.  
  2988. constructor TPopup.Init(AParent: PEventObject; tIndx,oIndx: integer);
  2989.  
  2990.     begin
  2991.         if not(inherited Init(AParent)) then fail;
  2992.         Style:=Style or es_Popup;
  2993.         shadow:=true;
  2994.         wait0:=true;
  2995.         active:=false;
  2996.         pIndex:=oIndx;
  2997.         pFlag:=POP_LEFTOP;
  2998.         pX:=0;
  2999.         pY:=0;
  3000.         if pIndex<ROOT then
  3001.             begin
  3002.                 inherited Done;
  3003.                 fail
  3004.             end;
  3005.         if tIndx<>id_No then
  3006.             begin
  3007.                 SetPopTree(Application^.GetAddr(tIndx));
  3008.                 if PopTree=nil then
  3009.                     begin
  3010.                         inherited Done;
  3011.                         fail
  3012.                     end
  3013.             end
  3014.     end;
  3015.  
  3016.  
  3017. procedure TPopup.SetPopTree(tree: PTree);
  3018.     var valid: boolean;
  3019.         q    : integer;
  3020.  
  3021.     begin
  3022.         PopTree:=tree;
  3023.         if PopTree=nil then exit;
  3024.         pMax:=PopTree^[pIndex].ob_tail+1-PopTree^[pIndex].ob_head;
  3025.         pRows:=pMax;
  3026.         if pRows>POP_MAXROWS then valid:=false
  3027.         else
  3028.             if (PopTree^[pIndex].ob_type and $ff)<>G_BOX then valid:=false
  3029.             else
  3030.                 begin
  3031.                     valid:=true;
  3032.                     for q:=PopTree^[pIndex].ob_head to PopTree^[pIndex].ob_tail do
  3033.                         if not((PopTree^[q].ob_type and $ff) in [G_STRING,G_USERDEF]) then
  3034.                             begin
  3035.                                 valid:=false;
  3036.                                 break
  3037.                             end
  3038.                 end;
  3039.         if not(valid) then PopTree:=nil
  3040.     end;
  3041.  
  3042.  
  3043. function TPopup.Execute: integer;
  3044.     label _error,_upagain,_dnagain,_raus;
  3045.  
  3046.     var scrn,memr    : MFDB;
  3047.         q,mx,my,ms,mc,
  3048.         evnt,key,rt,
  3049.         wflag,wx,wy,
  3050.         ww,wh,kstat  : integer;
  3051.         fmf          : word;
  3052.         blen,ql      : longint;
  3053.         qp           : pointer;
  3054.         qused,valid  : boolean;
  3055.         pipe         : Pipearray;
  3056.         vrec         : ARRAY_4;
  3057.         box          : GRECT;
  3058.         spec         : array [0..POP_MAXROWS-1] of OBSPEC;
  3059.         typ          : array [0..POP_MAXROWS-1] of integer;
  3060.         pxy          : record
  3061.                          case integer of
  3062.                            0: (b8     : ARRAY_8);
  3063.                            1: (b41,b42: ARRAY_4)
  3064.                        end;
  3065.  
  3066.     begin
  3067.         Execute:=id_No;
  3068.         if PopTree=nil then exit;
  3069.         wind_update(BEG_UPDATE);
  3070.         wind_update(BEG_MCTRL);
  3071.         active:=true;
  3072.         fmf:=ARROW;
  3073.         if Application^.MultiTOS then fmf:=fmf or MFORCE;
  3074.         gem.graf_mouse(fmf,nil);
  3075.         mnusr.ub_parm:=0;
  3076.         mnusr.ub_code:=@DrawMenuRect;
  3077.         for q:=PopTree^[pIndex].ob_head to PopTree^[pIndex].ob_tail do
  3078.             begin
  3079.                 PopTree^[q].ob_flags:=SELECTABLE;
  3080.                 PopTree^[q].ob_state:=PopTree^[q].ob_state and (DISABLED or CHECKED);
  3081.                 spec[q-PopTree^[pIndex].ob_head]:=PopTree^[q].ob_spec;
  3082.                 typ[q-PopTree^[pIndex].ob_head]:=PopTree^[q].ob_type;
  3083.                 if bTst(PopTree^[q].ob_state,DISABLED) then
  3084.                     begin
  3085.                         valid:=((PopTree^[q].ob_type and $ff)=G_USERDEF);
  3086.                         if not valid then valid:=(PChar(PopTree^[q].ob_spec.free_string)^='-');
  3087.                         if valid then
  3088.                             begin
  3089.                                 PopTree^[q].ob_type:=G_USERDEF;
  3090.                                 PopTree^[q].ob_spec.user_blk:=@mnusr
  3091.                             end
  3092.                     end
  3093.             end;
  3094.         with PopTree^[pIndex] do
  3095.             begin
  3096.                 if shadow then ob_state:=SHADOWED
  3097.                 else
  3098.                     ob_state:=NORMAL;
  3099.                 ob_x:=pX;
  3100.                 ob_y:=pY;
  3101.                 if pFlag=POP_CENTER then
  3102.                     begin
  3103.                         dec(ob_x,ob_width shr 1);
  3104.                         dec(ob_y,ob_height shr 1)
  3105.                     end;
  3106.                 if ob_x+ob_width>DRect.X2 then ob_x:=DRect.X2-ob_width;
  3107.                 if ob_y+ob_height>DRect.Y2 then ob_y:=DRect.Y2-ob_height;
  3108.                 if ob_x<=DRect.X1 then ob_x:=DRect.X1+1;
  3109.                 if ob_y<=DRect.Y1 then ob_y:=DRect.Y1+1;
  3110.                 box.X:=ob_x-outlwidth;
  3111.                 box.Y:=ob_y-outlwidth;
  3112.                 box.W:=ob_width+(outlwidth shl 1);
  3113.                 box.H:=ob_height+(outlwidth shl 1)
  3114.             end;
  3115.         HideMouse;
  3116.         if not(rc_intersect(DRect,box)) then goto _error;
  3117.         with memr do
  3118.             begin
  3119.                 fd_w:=box.W;
  3120.                 fd_h:=box.H;
  3121.                 fd_stand:=FF_DEVSPEC;
  3122.                 fd_wdwidth:=(fd_w+15) shr 4;
  3123.                 fd_nplanes:=Application^.Attr.Planes;
  3124.                 blen:=(longint(fd_wdwidth)*longint(fd_h)*longint(fd_nplanes)) shl 1
  3125.             end;
  3126.         if Application^.IsQSBUsed then ql:=-1
  3127.         else
  3128.             GetQSB(qp,ql);
  3129.         qused:=(ql>=blen);
  3130.         if qused then
  3131.             begin
  3132.                 memr.fd_addr:=qp;
  3133.                 Application^.IsQSBUsed:=true
  3134.             end
  3135.         else
  3136.             getmem(memr.fd_addr,blen);
  3137.         if memr.fd_addr=nil then goto _error;
  3138.         scrn.fd_addr:=nil;
  3139.         pxy.b8[0]:=box.X;
  3140.         pxy.b8[1]:=box.Y;
  3141.         pxy.b8[2]:=box.X+box.W-1;
  3142.         pxy.b8[3]:=box.Y+box.H-1;
  3143.         pxy.b8[4]:=0;
  3144.         pxy.b8[5]:=0;
  3145.         pxy.b8[6]:=memr.fd_w-1;
  3146.         pxy.b8[7]:=memr.fd_h-1;
  3147.         vro_cpyfm(Application^.vdiHandle,S_ONLY,pxy.b8,scrn,memr);
  3148.         objc_draw(PopTree,pIndex,MAX_DEPTH,DRect.X,DRect.Y,DRect.W,DRect.H);
  3149.         ShowMouse;
  3150.         obj:=id_No;
  3151.         evnt_timer(10,0);
  3152.         graf_mkstate(mx,my,mc,q);
  3153.         mc:=mc and 1;
  3154.         wflag:=0;
  3155.         with PopTree^[pIndex] do
  3156.             begin
  3157.                 wx:=ob_x;
  3158.                 wy:=ob_y;
  3159.                 ww:=ob_width;
  3160.                 wh:=ob_height
  3161.             end;
  3162.         repeat
  3163.             q:=objc_find(PopTree,pIndex,MAX_DEPTH,mx,my);
  3164.             if (q<>obj) and (q<>pIndex) then
  3165.                 begin
  3166.                     if obj>0 then
  3167.                         begin
  3168.                             PopTree^[obj].ob_state:=PopTree^[obj].ob_state and not(SELECTED);
  3169.                             vrec[0]:=PopTree^[obj].ob_x+PopTree^[pIndex].ob_x;
  3170.                             vrec[1]:=PopTree^[obj].ob_y+PopTree^[pIndex].ob_y;
  3171.                             vrec[2]:=vrec[0]+PopTree^[obj].ob_width-1;
  3172.                             vrec[3]:=vrec[1]+PopTree^[obj].ob_height-1;
  3173.                             HideMouse;
  3174.                             with Application^ do
  3175.                                 begin
  3176.                                     gem.vswr_mode(vdiHandle,MD_REPLACE);
  3177.                                     gem.vsf_interior(vdiHandle,FIS_HOLLOW);
  3178.                                     vr_recfl(vdiHandle,vrec);
  3179.                                     gem.vswr_mode(vdiHandle,GP.wrmode);
  3180.                                     gem.vsf_interior(vdiHandle,GP.finterior)
  3181.                                 end;
  3182.                             objc_draw(PopTree,obj,MAX_DEPTH,DRect.X,DRect.Y,DRect.W,DRect.H);
  3183.                             ShowMouse
  3184.                         end;
  3185.                     obj:=id_No;
  3186.                     if q<=0 then
  3187.                         begin
  3188.                             wflag:=0;
  3189.                             with PopTree^[pIndex] do
  3190.                                 begin
  3191.                                     wx:=ob_x;
  3192.                                     wy:=ob_y;
  3193.                                     ww:=ob_width;
  3194.                                     wh:=ob_height
  3195.                                 end
  3196.                         end
  3197.                     else
  3198.                         if not(bTst(PopTree^[q].ob_state,DISABLED)) then
  3199.                             begin
  3200.                                 obj:=q;
  3201.                                 PopTree^[obj].ob_state:=PopTree^[obj].ob_state or SELECTED;
  3202.                                 HideMouse;
  3203.                                 objc_draw(PopTree,obj,MAX_DEPTH,DRect.X,DRect.Y,DRect.W,DRect.H);
  3204.                                 ShowMouse;
  3205.                                 wflag:=1;
  3206.                                 with PopTree^[obj] do
  3207.                                     begin
  3208.                                         wx:=ob_x+PopTree^[pIndex].ob_x;
  3209.                                         wy:=ob_y+PopTree^[pIndex].ob_y;
  3210.                                         ww:=ob_width;
  3211.                                         wh:=ob_height
  3212.                                     end
  3213.                             end
  3214.                         else
  3215.                             begin
  3216.                                 wflag:=1;
  3217.                                 with PopTree^[q] do
  3218.                                     begin
  3219.                                         wx:=ob_x+PopTree^[pIndex].ob_x;
  3220.                                         wy:=ob_y+PopTree^[pIndex].ob_y;
  3221.                                         ww:=ob_width;
  3222.                                         wh:=ob_height
  3223.                                     end
  3224.                             end
  3225.                 end;
  3226.             if q=-1 then
  3227.                 begin
  3228.                     rt:=ExitPop(mx,my);
  3229.                     if rt<>id_No then
  3230.                         begin
  3231.                             Execute:=rt;
  3232.                             goto _raus
  3233.                         end
  3234.                 end;
  3235.             evnt:=evnt_multi(MU_KEYBD or MU_TIMER or MU_BUTTON or MU_M1,257,3,0,wflag,wx,wy,ww,wh,0,0,0,0,0,pipe,poptimer,0,mx,my,ms,kstat,key,q);
  3236.             if bTst(ms,2) then
  3237.                 begin
  3238.                     evnt:=MU_KEYBD;
  3239.                     key:=S_Esc
  3240.                 end;
  3241.             if bTst(evnt,MU_KEYBD) then
  3242.                 begin
  3243.                     case key of
  3244.                     Home,Shift_CU:
  3245.                         if isanyenabled then
  3246.                             begin
  3247.                                 q:=0;
  3248.                                 while GetState(q)=bf_Disabled do inc(q);
  3249.                                 MouseSim(q)
  3250.                             end;
  3251.                     Shift_Home,Shift_CD:
  3252.                         if isanyenabled then
  3253.                             begin
  3254.                                 q:=pRows-1;
  3255.                                 while GetState(q)=bf_Disabled do dec(q);
  3256.                                 MouseSim(q)
  3257.                             end;
  3258.                     Cur_Up:
  3259.                         if isanyenabled then
  3260.                             begin
  3261.                                 if obj>0 then
  3262.                                     begin
  3263.                                         q:=obj-PopTree^[pIndex].ob_head-1;
  3264.                                         _upagain:
  3265.                                         if q>=0 then
  3266.                                             if GetState(q)=bf_Disabled then
  3267.                                                 begin
  3268.                                                     dec(q);
  3269.                                                     goto _upagain
  3270.                                                 end;
  3271.                                         if q<0 then
  3272.                                             begin
  3273.                                                 q:=pRows-1;
  3274.                                                 goto _upagain
  3275.                                             end;
  3276.                                         MouseSim(q)
  3277.                                     end
  3278.                                 else
  3279.                                     begin
  3280.                                         q:=pRows-1;
  3281.                                         while GetState(q)=bf_Disabled do dec(q);
  3282.                                         MouseSim(q)
  3283.                                     end
  3284.                             end;
  3285.                     Cur_Down:
  3286.                         if isanyenabled then
  3287.                             begin
  3288.                                 if obj>0 then
  3289.                                     begin
  3290.                                         q:=obj+1-PopTree^[pIndex].ob_head;
  3291.                                         _dnagain:
  3292.                                         if q<pRows then
  3293.                                             if GetState(q)=bf_Disabled then
  3294.                                                 begin
  3295.                                                     inc(q);
  3296.                                                     goto _dnagain
  3297.                                                 end;
  3298.                                         if q>=pRows then
  3299.                                             begin
  3300.                                                 q:=0;
  3301.                                                 goto _dnagain
  3302.                                             end;
  3303.                                         MouseSim(q)
  3304.                                     end
  3305.                                 else
  3306.                                     begin
  3307.                                         q:=0;
  3308.                                         while GetState(q)=bf_Disabled do inc(q);
  3309.                                         MouseSim(q)
  3310.                                     end
  3311.                             end;
  3312.                     Return,Enter,$3920:
  3313.                         ms:=mc xor 1;
  3314.                     S_Esc,S_Undo:
  3315.                         begin
  3316.                             if obj>0 then PopTree^[obj].ob_state:=PopTree^[obj].ob_state and not(SELECTED);
  3317.                             obj:=id_No;
  3318.                             ms:=mc xor 1
  3319.                         end
  3320.                     else
  3321.                         if not(TestKey(kstat,key)) then
  3322.                             begin
  3323.                                 rt:=KeyExit(kstat,key);
  3324.                                 if rt<>id_No then
  3325.                                     begin
  3326.                                         Execute:=rt;
  3327.                                         if obj>0 then PopTree^[obj].ob_state:=PopTree^[obj].ob_state and not(SELECTED);
  3328.                                         goto _raus
  3329.                                     end
  3330.                             end
  3331.                     end
  3332.                 end
  3333.         until (ms and 3)<>mc;
  3334.         if obj>0 then
  3335.             begin
  3336.                 PopTree^[obj].ob_state:=PopTree^[obj].ob_state and not(SELECTED);
  3337.                 Execute:=obj-PopTree^[pIndex].ob_head
  3338.             end
  3339.         else
  3340.             Execute:=id_No;
  3341.         _raus:
  3342.         HideMouse;
  3343.         scrn.fd_addr:=nil;
  3344.         vrec:=pxy.b41;
  3345.         pxy.b41:=pxy.b42;
  3346.         pxy.b42:=vrec;
  3347.         vro_cpyfm(Application^.vdiHandle,S_ONLY,pxy.b8,memr,scrn);
  3348.         if qused then Application^.IsQSBUsed:=false
  3349.         else
  3350.             freemem(memr.fd_addr,blen);
  3351.         _error:
  3352.         ShowMouse;
  3353.         for q:=PopTree^[pIndex].ob_head to PopTree^[pIndex].ob_tail do
  3354.             begin
  3355.                 PopTree^[q].ob_spec:=spec[q-PopTree^[pIndex].ob_head];
  3356.                 PopTree^[q].ob_type:=typ[q-PopTree^[pIndex].ob_head]
  3357.             end;
  3358.         gem.graf_mouse(GP.mnr,@GP.mform);
  3359.         if wait0 then
  3360.             repeat
  3361.                 graf_mkstate(mx,my,ms,q)
  3362.             until ms=0;
  3363.         active:=false;
  3364.         wind_update(END_MCTRL);
  3365.         wind_update(END_UPDATE)
  3366.     end;
  3367.  
  3368.  
  3369. function TPopup.ExitPop(mX,mY: integer): integer;
  3370.  
  3371.     begin
  3372.         ExitPop:=id_No
  3373.     end;
  3374.  
  3375.  
  3376. function TPopup.KeyExit(Stat,Key: integer): integer;
  3377.  
  3378.     begin
  3379.         KeyExit:=id_No
  3380.     end;
  3381.  
  3382.  
  3383. procedure TPopup.SetSelection(nr: integer);
  3384.  
  3385.     begin
  3386.         if active then
  3387.             if isanyenabled then
  3388.                 begin
  3389.                     if nr<0 then nr:=0;
  3390.                     if nr>=pRows then nr:=pRows-1;
  3391.                     if GetState(nr)<>bf_Disabled then
  3392.                         if nr<>GetSelection then MouseSim(nr)
  3393.                 end
  3394.     end;
  3395.  
  3396.  
  3397. function TPopup.GetSelection: integer;
  3398.  
  3399.     begin
  3400.         if active then GetSelection:=obj
  3401.         else
  3402.             GetSelection:=id_No
  3403.     end;
  3404.  
  3405.  
  3406. procedure TPopup.SetText(nr: integer; ATextString: string);
  3407.  
  3408.     begin
  3409.         if (nr>=0) and (nr<pRows) and (PopTree<>nil) then
  3410.             StrPCopy(PopTree^[nr+PopTree^[pIndex].ob_head].ob_spec.free_string,ATextString)
  3411.     end;
  3412.  
  3413.  
  3414. function TPopup.GetText(nr: integer): string;
  3415.  
  3416.     begin
  3417.         if (nr>=0) and (nr<pRows) and (PopTree<>nil) then
  3418.             GetText:=StrPas(PopTree^[nr+PopTree^[pIndex].ob_head].ob_spec.free_string)
  3419.         else
  3420.             GetText:=''
  3421.     end;
  3422.  
  3423.  
  3424. procedure TPopup.SetState(nr,StateFlag: integer);
  3425.  
  3426.     begin
  3427.         if (nr>=0) and (nr<pRows) and (PopTree<>nil) then
  3428.             begin
  3429.                 if StateFlag=bf_Disabled then PopTree^[nr+PopTree^[pIndex].ob_head].ob_state:=PopTree^[nr+PopTree^[pIndex].ob_head].ob_state or DISABLED
  3430.                 else
  3431.                     PopTree^[nr+PopTree^[pIndex].ob_head].ob_state:=PopTree^[nr+PopTree^[pIndex].ob_head].ob_state and not(DISABLED)
  3432.             end
  3433.     end;
  3434.  
  3435.  
  3436. function TPopup.GetState(nr: integer): integer;
  3437.  
  3438.     begin
  3439.         if (nr>=0) and (nr<pRows) and (PopTree<>nil) then
  3440.             begin
  3441.                 if bTst(PopTree^[nr+PopTree^[pIndex].ob_head].ob_state,DISABLED) then GetState:=bf_Disabled
  3442.                 else
  3443.                     GetState:=bf_Enabled
  3444.             end
  3445.         else
  3446.             GetState:=id_No
  3447.     end;
  3448.  
  3449.  
  3450. procedure TPopup.Disable(nr: integer);
  3451.  
  3452.     begin
  3453.         SetState(nr,bf_Disabled)
  3454.     end;
  3455.  
  3456.  
  3457. procedure TPopup.Enable(nr: integer);
  3458.  
  3459.     begin
  3460.         SetState(nr,bf_Enabled)
  3461.     end;
  3462.  
  3463.  
  3464. procedure TPopup.SetCheck(nr,CheckFlag: integer);
  3465.  
  3466.     begin
  3467.         if (nr>=0) and (nr<pRows) and (PopTree<>nil) then
  3468.             begin
  3469.                 if CheckFlag=bf_Checked then PopTree^[nr+PopTree^[pIndex].ob_head].ob_state:=PopTree^[nr+PopTree^[pIndex].ob_head].ob_state or CHECKED
  3470.                 else
  3471.                     PopTree^[nr+PopTree^[pIndex].ob_head].ob_state:=PopTree^[nr+PopTree^[pIndex].ob_head].ob_state and not(CHECKED)
  3472.             end
  3473.     end;
  3474.  
  3475.  
  3476. function TPopup.GetCheck(nr: integer): integer;
  3477.  
  3478.     begin
  3479.         if (nr>=0) and (nr<pRows) and (PopTree<>nil) then
  3480.             begin
  3481.                 if bTst(PopTree^[nr+PopTree^[pIndex].ob_head].ob_state,CHECKED) then GetCheck:=bf_Checked
  3482.                 else
  3483.                     GetCheck:=bf_Unchecked
  3484.             end
  3485.         else
  3486.             GetCheck:=id_No
  3487.     end;
  3488.  
  3489.  
  3490. procedure TPopup.Check(nr: integer);
  3491.  
  3492.     begin
  3493.         SetCheck(nr,bf_Checked)
  3494.     end;
  3495.  
  3496.  
  3497. procedure TPopup.Uncheck(nr: integer);
  3498.  
  3499.     begin
  3500.         SetCheck(nr,bf_Unchecked)
  3501.     end;
  3502.  
  3503.  
  3504. procedure TPopup.Toggle(nr: integer);
  3505.  
  3506.     begin
  3507.         if GetCheck(nr)=bf_Unchecked then SetCheck(nr,bf_Checked)
  3508.         else
  3509.             SetCheck(nr,bf_Unchecked)
  3510.     end;
  3511.  
  3512.  
  3513.     { private }
  3514.  
  3515.  
  3516. procedure TPopup.MouseSim(sobj: integer);
  3517.  
  3518.     begin
  3519.         with PopTree^[pIndex] do
  3520.             SetMouse(ob_x+PopTree^[ob_head+sobj].ob_x+(PopTree^[ob_head+sobj].ob_width shr 1),ob_y+PopTree^[ob_head+sobj].ob_y+(PopTree^[ob_head+sobj].ob_height shr 1))
  3521.     end;
  3522.  
  3523.  
  3524. function TPopup.isanyenabled: boolean;
  3525.     var q: integer;
  3526.  
  3527.     begin
  3528.         isanyenabled:=false;
  3529.         for q:=0 to pRows-1 do
  3530.             if GetState(q)=bf_Enabled then
  3531.                 begin
  3532.                     isanyenabled:=true;
  3533.                     exit
  3534.                 end
  3535.     end;
  3536.  
  3537. { *** TPOPUP *** }
  3538.  
  3539.  
  3540.  
  3541. { *** Objekt TSCROLLER *** }
  3542.  
  3543. constructor TScroller.Init(TheWindow: PWindow; TheXUnit,TheYUnit: integer; TheXRange,TheYRange: longint);
  3544.  
  3545.     begin
  3546.         if not(inherited Init) then fail;
  3547.         Window:=TheWindow;
  3548.         if Window=nil then
  3549.             begin
  3550.                 inherited Done;
  3551.                 fail
  3552.             end;
  3553.         Window^.Scroller:=@self;
  3554.         TrackMode:=true;
  3555.         HasVScrollBar:=bTst(Window^.Attr.Style,VSLIDE);
  3556.         HasHScrollBar:=bTst(Window^.Attr.Style,HSLIDE);
  3557.         Style:=0;
  3558.         XLine:=1;
  3559.         YLine:=1;
  3560.         XPos:=0;
  3561.         YPos:=0;
  3562.         XUnit:=TheXUnit;
  3563.         YUnit:=TheYUnit;
  3564.         if XUnit<1 then XUnit:=1;
  3565.         if YUnit<1 then YUnit:=1;
  3566.         SetPageSize;
  3567.         SetRange(TheXRange,TheYRange)
  3568.     end;
  3569.  
  3570.  
  3571. destructor TScroller.Done;
  3572.  
  3573.     begin
  3574.         Window^.Scroller:=nil;
  3575.         inherited Done
  3576.     end;
  3577.  
  3578.  
  3579. procedure TScroller.HScroll;
  3580.     var dif: longint;
  3581.  
  3582.     begin
  3583.         if HasHScrollBar then
  3584.             begin
  3585.                 dif:=XRange-XPage-1;
  3586.                 if dif<1 then dif:=1;
  3587.                 dif:=(1000*XPos) div dif;
  3588.                 if dif>1000 then dif:=1000;
  3589.                 with Window^.Attr do
  3590.                     if gemHandle>=0 then
  3591.                         wind_set(gemHandle,WF_HSLIDE,dif,0,0,0)
  3592.             end
  3593.     end;
  3594.  
  3595.  
  3596. procedure TScroller.VScroll;
  3597.     var dif: longint;
  3598.  
  3599.     begin
  3600.         if HasVScrollBar then
  3601.             begin
  3602.                 dif:=YRange-YPage-1;
  3603.                 if dif<1 then dif:=1;
  3604.                 dif:=(1000*YPos) div dif;
  3605.                 if dif>1000 then dif:=1000;
  3606.                 with Window^.Attr do
  3607.                     if gemHandle>=0 then
  3608.                         wind_set(gemHandle,WF_VSLIDE,dif,0,0,0)
  3609.             end
  3610.     end;
  3611.  
  3612.  
  3613. function TScroller.IsVisibleRect(X,Y,XExt,YExt: longint): boolean;
  3614.     var r: GRECT;
  3615.  
  3616.     begin
  3617.         r.X:=(X-XPos)*XUnit+Window^.Work.X;
  3618.         r.Y:=(Y-YPos)*YUnit+Window^.Work.Y;
  3619.         r.W:=XExt*XUnit;
  3620.         r.H:=YExt*YUnit;
  3621.         IsVisibleRect:=rc_intersect(Window^.Work,r)
  3622.     end;
  3623.  
  3624.  
  3625. procedure TScroller.ScrollBy(dX,dY: longint);
  3626.     var pw,ph,xdif,ydif: integer;
  3627.  
  3628.     begin
  3629.         inc(dX,XPos);
  3630.         inc(dY,YPos);
  3631.         pw:=Window^.Work.W div XUnit;
  3632.         ph:=Window^.Work.H div YUnit;
  3633.         if dX+pw>=XRange then dX:=XRange-pw-1;
  3634.         if dY+ph>=YRange then dY:=YRange-ph-1;
  3635.         if dX<0 then dX:=0;
  3636.         if dY<0 then dY:=0;
  3637.         if (dX<>XPos) or (dY<>YPos) then
  3638.             begin
  3639.                 if dX<>XPos then
  3640.                     begin
  3641.                         xdif:=(dX-XPos)*XUnit;
  3642.                         XPos:=dX;
  3643.                         HScroll
  3644.                     end
  3645.                 else
  3646.                     xdif:=0;
  3647.                 if dY<>YPos then
  3648.                     begin
  3649.                         ydif:=(dY-YPos)*YUnit;
  3650.                         YPos:=dY;
  3651.                         VScroll
  3652.                     end
  3653.                 else
  3654.                     ydif:=0;
  3655.                 RedrawParent(xdif,ydif)
  3656.             end
  3657.     end;
  3658.  
  3659.  
  3660. procedure TScroller.ScrollTo(X,Y: longint);
  3661.     var pw,ph,xdif,ydif: integer;
  3662.  
  3663.     begin
  3664.         pw:=Window^.Work.W div XUnit;
  3665.         ph:=Window^.Work.H div YUnit;
  3666.         if X+pw>=XRange then X:=XRange-pw-1;
  3667.         if Y+ph>=YRange then Y:=YRange-ph-1;
  3668.         if X<0 then X:=0;
  3669.         if Y<0 then Y:=0;
  3670.         if (X<>XPos) or (Y<>YPos) then
  3671.             begin
  3672.                 if X<>XPos then
  3673.                     begin
  3674.                         xdif:=(X-XPos)*XUnit;
  3675.                         XPos:=X;
  3676.                         HScroll
  3677.                     end
  3678.                 else
  3679.                     xdif:=0;
  3680.                 if Y<>YPos then
  3681.                     begin
  3682.                         ydif:=(Y-YPos)*YUnit;
  3683.                         YPos:=Y;
  3684.                         VScroll
  3685.                     end
  3686.                 else
  3687.                     ydif:=0;
  3688.                 RedrawParent(xdif,ydif)
  3689.             end
  3690.     end;
  3691.  
  3692.  
  3693. procedure TScroller.SetPageSize;
  3694.  
  3695.     begin
  3696.         XPage:=Window^.Work.W div XUnit;
  3697.         YPage:=Window^.Work.H div YUnit
  3698.     end;
  3699.  
  3700.  
  3701. procedure TScroller.SetSBarRange;
  3702.     var dummy,pw,ph,xp,yp: longint;
  3703.         valid            : boolean;
  3704.  
  3705.     begin
  3706.         pw:=Window^.Work.W div XUnit;
  3707.         ph:=Window^.Work.H div YUnit;
  3708.         xp:=XPos;
  3709.         yp:=YPos;
  3710.         if xp+pw>=XRange then xp:=XRange-pw-1;
  3711.         if yp+ph>=YRange then yp:=YRange-ph-1;
  3712.         if xp<0 then xp:=0;
  3713.         if yp<0 then yp:=0;
  3714.         valid:=((xp<>XPos) or (yp<>YPos));
  3715.         XPos:=xp;
  3716.         YPos:=yp;
  3717.         if HasHScrollBar then
  3718.             begin
  3719.                 dummy:=(1000*(pw+1)) div XRange;
  3720.                 if dummy<1 then dummy:=1;
  3721.                 if dummy>1000 then dummy:=1000;
  3722.                 with Window^.Attr do
  3723.                     if gemHandle>=0 then
  3724.                         wind_set(gemHandle,WF_HSLSIZE,dummy,0,0,0)
  3725.             end;
  3726.         if HasVScrollBar then
  3727.             begin
  3728.                 dummy:=(1000*(ph+1)) div YRange;
  3729.                 if dummy<1 then dummy:=1;
  3730.                 if dummy>1000 then dummy:=1000;
  3731.                 with Window^.Attr do
  3732.                     if gemHandle>=0 then
  3733.                         wind_set(gemHandle,WF_VSLSIZE,dummy,0,0,0)
  3734.             end;
  3735.         HScroll;
  3736.         VScroll;
  3737.         if valid then Window^.ForceRedraw
  3738.     end;
  3739.  
  3740.  
  3741. procedure TScroller.SetRange(TheXRange,TheYRange: longint);
  3742.  
  3743.     begin
  3744.         XRange:=TheXRange;
  3745.         YRange:=TheYRange;
  3746.         if XRange<1 then XRange:=1;
  3747.         if YRange<1 then YRange:=1;
  3748.         SetSBarRange
  3749.     end;
  3750.  
  3751.  
  3752. procedure TScroller.SetUnits(TheXUnit,TheYUnit: integer);
  3753.  
  3754.     begin
  3755.         if TheXUnit<1 then TheXUnit:=1;
  3756.         if TheYUnit<1 then TheYUnit:=1;
  3757.         if (XUnit<>TheXUnit) or (YUnit<>TheYUnit) then
  3758.             begin
  3759.                 XUnit:=TheXUnit;
  3760.                 YUnit:=TheYUnit;
  3761.                 Window^.ForceRedraw
  3762.             end
  3763.     end;
  3764.  
  3765.  
  3766. function TScroller.GetXOrg: longint;
  3767.  
  3768.     begin
  3769.         GetXOrg:=Window^.Work.X-XPos*XUnit
  3770.     end;
  3771.  
  3772.  
  3773. function TScroller.GetYOrg: longint;
  3774.  
  3775.     begin
  3776.         GetYOrg:=Window^.Work.Y-YPos*YUnit
  3777.     end;
  3778.  
  3779.  
  3780.     { private }
  3781.  
  3782.  
  3783. procedure TScroller.RedrawParent(xdif,ydif: integer);
  3784.     label _fertig;
  3785.  
  3786.     var sm,dm     : MFDB;
  3787.         xy        : ARRAY_8;
  3788.         rect,vr,hr: GRECT;
  3789.         valid     : boolean;
  3790.         pipe      : Pipearray;
  3791.  
  3792.     procedure zeichnen(box: GRECT);
  3793.         var PaintInfo: TPaintStruct;
  3794.  
  3795.         begin
  3796.             vs_clip(Window^.vdiHandle,CLIP_ON,box.A2);
  3797.             with PaintInfo do
  3798.                 begin
  3799.                     rcPaint:=box;
  3800.                     feColor:=Window^.Class.hbrBackground-1;
  3801.                     if feColor>=0 then
  3802.                         begin
  3803.                             fErase:=true;
  3804.                             gem.vswr_mode(Window^.vdiHandle,MD_REPLACE);
  3805.                             gem.vsf_interior(Window^.vdiHandle,FIS_SOLID);
  3806.                             gem.vsf_color(Window^.vdiHandle,feColor);
  3807.                             vr_recfl(Window^.vdiHandle,rcPaint.A2);
  3808.                             gem.vswr_mode(Window^.vdiHandle,GP.wrmode);
  3809.                             gem.vsf_interior(Window^.vdiHandle,GP.finterior);
  3810.                             gem.vsf_color(Window^.vdiHandle,GP.fcolor)
  3811.                         end
  3812.                     else
  3813.                         fErase:=false
  3814.                 end;
  3815.             Window^.Paint(PaintInfo);
  3816.             vs_clip(Window^.vdiHandle,CLIP_ON,DRect.A2)
  3817.         end;
  3818.  
  3819.     begin
  3820.         if Window^.Attr.Status<>ws_Open then exit;
  3821.         if (xdif=0) and (ydif=0) then exit;
  3822.         if not(TrackMode) or Window^.IsIconified then
  3823.             begin
  3824.                 Window^.ForceRedraw;
  3825.                 exit
  3826.             end;
  3827.         wind_update(BEG_UPDATE);
  3828.         if not(bTst(Style,scs_BitbltScrolling)) then
  3829.             begin
  3830.                 with Window^ do WMRedraw(Work.X,Work.Y,Work.W,Work.H);
  3831.                 goto _fertig
  3832.             end;
  3833.         HideMouse;
  3834.         valid:=Window^.FirstWorkRect(rect);
  3835.         Window^.UpdateDialog;
  3836.         Window^.InitPaint;
  3837.         while valid do
  3838.             begin
  3839.                 if (rect.H>=abs(ydif)+YUnit) and (rect.W>=abs(xdif)+XUnit) then
  3840.                     begin
  3841.                         with rect do
  3842.                             begin
  3843.                                 if ydif>0 then
  3844.                                     begin
  3845.                                         xy[1]:=Y1+ydif;
  3846.                                         xy[3]:=Y2;
  3847.                                         xy[5]:=Y1;
  3848.                                         xy[7]:=Y2-ydif;
  3849.                                         vr.Y1:=Y2+1-ydif;
  3850.                                         vr.Y2:=Y2
  3851.                                     end
  3852.                                 else
  3853.                                     begin
  3854.                                         xy[1]:=Y1;
  3855.                                         xy[3]:=Y2+ydif;
  3856.                                         xy[5]:=Y1-ydif;
  3857.                                         xy[7]:=Y2;
  3858.                                         vr.Y1:=Y1;
  3859.                                         vr.Y2:=Y1-ydif-1
  3860.                                     end;
  3861.                                 if xdif>0 then
  3862.                                     begin
  3863.                                         xy[0]:=X1+xdif;
  3864.                                         xy[2]:=X2;
  3865.                                         xy[4]:=X1;
  3866.                                         xy[6]:=X2-xdif;
  3867.                                         hr.X1:=X2+1-xdif;
  3868.                                         hr.X2:=X2
  3869.                                     end
  3870.                                 else
  3871.                                     begin
  3872.                                         xy[0]:=X1;
  3873.                                         xy[2]:=X2+xdif;
  3874.                                         xy[4]:=X1-xdif;
  3875.                                         xy[6]:=X2;
  3876.                                         hr.X1:=X1;
  3877.                                         hr.X2:=X1-xdif-1
  3878.                                     end
  3879.                             end;
  3880.                         sm.fd_addr:=nil;
  3881.                         dm.fd_addr:=nil;
  3882.                         vro_cpyfm(Window^.vdiHandle,S_ONLY,xy,sm,dm);
  3883.                         if ydif<>0 then
  3884.                             begin
  3885.                                 vr.X1:=rect.X1;
  3886.                                 vr.X2:=rect.X2;
  3887.                                 A2toGR(vr);
  3888.                                 zeichnen(vr)
  3889.                             end;
  3890.                         if xdif<>0 then
  3891.                             begin
  3892.                                 hr.Y1:=rect.Y1;
  3893.                                 hr.Y2:=rect.Y2;
  3894.                                 A2toGR(hr);
  3895.                                 zeichnen(hr)
  3896.                             end
  3897.                     end
  3898.                 else
  3899.                     zeichnen(rect);
  3900.                 valid:=Window^.NextWorkRect(rect)
  3901.             end;
  3902.         Window^.ExitPaint;
  3903.         vs_clip(Window^.vdiHandle,CLIP_ON,DRect.A2);
  3904.         ShowMouse;
  3905.         _fertig:
  3906.         wind_update(END_UPDATE)
  3907.     end;
  3908.  
  3909. { *** TSCROLLER *** }
  3910.  
  3911.  
  3912.  
  3913. { *** Objekt TWINDOW *** }
  3914.  
  3915. constructor TWindow.Init(AParent: PWindow; ATitle: string);
  3916.     var p : PWindow;
  3917.         pp: ^PWindow;
  3918.  
  3919.   begin
  3920.       if not(inherited Init) then fail;
  3921.       Parent:=AParent;
  3922.     inc(Application^.HMax);
  3923.     with Attr do
  3924.         begin
  3925.           Title:=nil;
  3926.             SubTitle:=nil;
  3927.             Handle:=Application^.HMax;
  3928.             gemHandle:=-1;
  3929.             Style:=GetStyle;
  3930.             ExStyle:=ws_ex_Modeless;
  3931.                 fillchar(RBox,sizeof(RBox),0);
  3932.             Status:=ws_NoWindow
  3933.         end;
  3934.     vdiHandle:=Application^.vdiHandle;
  3935.     ChildList:=nil;
  3936.     Scroller:=nil;
  3937.     Icon:=nil;
  3938.     Prev:=nil;
  3939.     Nxt:=nil;
  3940.     if Parent<>nil then pp:=@Parent^.ChildList
  3941.     else
  3942.         pp:=@Application^.MainWindow;
  3943.         if pp^=nil then pp^:=@self
  3944.         else
  3945.             begin
  3946.                 p:=pp^;
  3947.                 while p^.Nxt<>nil do p:=p^.Nxt;
  3948.                 p^.Nxt:=@self;
  3949.                 Prev:=p
  3950.             end;
  3951.         DlgTree:=nil;
  3952.         tbtree:=-1;
  3953.         icntitl:=nil;
  3954.         icfpos:=-1;
  3955.         nxticn:=nil;
  3956.     GetWindowClass(Class);
  3957.     GetIconWindowClass(IconClass);
  3958.     EnableAutoCreate;
  3959.     SetTitle(ATitle);
  3960.     SetSubTitle('');
  3961.     Scroller:=GetScroller;
  3962.     Clipboard:=GetClipboard;
  3963.     SetupWindow
  3964.   end;
  3965.  
  3966.  
  3967. destructor TWindow.Done;
  3968.     var pp: ^PWindow;
  3969.  
  3970.     begin
  3971.         while (ChildList<>nil) do ChildList^.Free;
  3972.         ShutdownWindow;
  3973.         if Attr.Status in [ws_Created,ws_Open] then Destroy;
  3974.         FreeIcon;
  3975.         FreeDialog;
  3976.         FreeToolbar;
  3977.         FreeMenu;
  3978.         if Attr.Handle=Application^.HMax then dec(Application^.HMax);
  3979.     if Parent<>nil then pp:=@Parent^.ChildList
  3980.         else pp:=@Application^.MainWindow;
  3981.         if (Prev=nil) and (Nxt=nil) then pp^:=nil
  3982.         else
  3983.             begin
  3984.                 if Prev=nil then pp^:=Nxt
  3985.                     else Prev^.Nxt:=Nxt;
  3986.                 if Nxt<>nil then Nxt^.Prev:=Prev
  3987.             end;
  3988.         DisposeStr(Attr.Title);
  3989.         DisposeStr(Attr.SubTitle);
  3990.         DisposeStr(Class.lpszClassName);
  3991.         if Scroller<>nil then dispose(Scroller,Done);
  3992.         if Clipboard<>nil then
  3993.             if Clipboard^.Parent=@self then dispose(Clipboard,Done);
  3994.         inherited Done
  3995.     end;
  3996.  
  3997.  
  3998. function TWindow.GetStyle: integer;
  3999.     var ret: integer;
  4000.  
  4001.     begin
  4002.         ret:=NAME or INFO or CLOSER or MOVER or FULLER or SIZER;
  4003.         if agi.Iconify then
  4004.             begin
  4005.                 if TOSVersion=$0492 then ret:=ret or $1000
  4006.                 else
  4007.                     ret:=ret or SMALLER
  4008.             end;
  4009.         if bTst(agi.Gadgets,2) then ret:=ret or BACKDROP;
  4010.         GetStyle:=ret
  4011.     end;
  4012.  
  4013.  
  4014. function TWindow.GetScroller: PScroller;
  4015.  
  4016.     begin
  4017.         GetScroller:=nil
  4018.     end;
  4019.  
  4020.  
  4021. function TWindow.GetClipboard: PClipboard;
  4022.  
  4023.     begin
  4024.         GetClipboard:=Application^.Clipboard
  4025.     end;
  4026.  
  4027.  
  4028. procedure TWindow.GetWindowClass(var AWndClass: TWndClass);
  4029.  
  4030.     begin
  4031.         with AWndClass do
  4032.             begin
  4033.                 Style:=cs_DblClks or cs_CreateOnAccOpen or cs_AutoOpen or cs_QuitOnClose;
  4034.                 hCursor:=ARROW;
  4035.                 hbrBackground:=White+1;
  4036.                 ToolbarTree:=nil;
  4037.                 MenuTree:=nil;
  4038.                 lpszClassName:=NewStr(GetClassName)
  4039.             end
  4040.     end;
  4041.  
  4042.  
  4043. procedure TWindow.GetIconWindowClass(var AWndClass: TIconWndClass);
  4044.  
  4045.     begin
  4046.         with AWndClass do
  4047.             begin
  4048.                 hCursor:=ARROW;
  4049.                 hbrBackground:=White+1
  4050.             end
  4051.     end;
  4052.  
  4053.  
  4054. function TWindow.GetClassName: string;
  4055.  
  4056.     begin
  4057.         GetClassName:='Window'
  4058.     end;
  4059.  
  4060.  
  4061. function TWindow.GetIconTitle: string;
  4062.  
  4063.     begin
  4064.         GetIconTitle:=GetTitle
  4065.     end;
  4066.  
  4067.  
  4068. function TWindow.GetTitle: string;
  4069.     var ret: string;
  4070.  
  4071.     begin
  4072.         if Attr.Title=nil then GetTitle:=''
  4073.         else
  4074.             begin
  4075.                 ret:=Attr.Title^;
  4076.                 while StrPRight(ret,1)=#0 do ret:=StrPLeft(ret,length(ret)-1);
  4077.                 GetTitle:=StrPTrimF(ret)
  4078.             end
  4079.     end;
  4080.  
  4081.  
  4082. function TWindow.CanClose: boolean;
  4083.     var valid: boolean;
  4084.             p    : PWindow;
  4085.  
  4086.     begin
  4087.         valid:=true;
  4088.       p:=ChildList;
  4089.       while (p<>nil) and valid do
  4090.           with p^ do
  4091.               begin
  4092.                   if Attr.Status=ws_Open then
  4093.                       if not(CanClose) then valid:=false;
  4094.                   p:=Nxt
  4095.               end;
  4096.         CanClose:=valid
  4097.     end;
  4098.  
  4099.  
  4100. function TWindow.IsIconified: boolean;
  4101.     var valid,dummy: integer;
  4102.  
  4103.     begin
  4104.         if agi.Iconify and (Attr.gemHandle>=0) then
  4105.             begin
  4106.                 wind_get(Attr.gemHandle,WF_ICONIFY,valid,dummy,dummy,dummy);
  4107.                 IsIconified:=(valid<>0)
  4108.             end
  4109.         else
  4110.             IsIconified:=(icfpos>=0)
  4111.     end;
  4112.  
  4113.  
  4114. function TWindow.IsModeless: boolean;
  4115.  
  4116.     begin
  4117.         IsModeless:=(Attr.gemHandle>=0)
  4118.     end;
  4119.  
  4120.  
  4121. function TWindow.IsDialog: boolean;
  4122.  
  4123.     begin
  4124.         IsDialog:=false
  4125.     end;
  4126.  
  4127.  
  4128. function TWindow.IsTop: boolean;
  4129.     var tw,dummy: integer;
  4130.  
  4131.     begin
  4132.         wind_get(DESK,WF_TOP,tw,dummy,dummy,dummy);
  4133.         IsTop:=((tw=Attr.gemHandle) and (Application^.DlgTop<0))
  4134.     end;
  4135.  
  4136.  
  4137. procedure TWindow.EnableAutoCreate;
  4138.  
  4139.     begin
  4140.         Class.Style:=Class.Style or cs_AutoCreate
  4141.     end;
  4142.  
  4143.  
  4144. procedure TWindow.DisableAutoCreate;
  4145.  
  4146.     begin
  4147.         Class.Style:=Class.Style and not(cs_AutoCreate)
  4148.     end;
  4149.  
  4150.  
  4151. procedure TWindow.GetFull;
  4152.     var r    : GRECT;
  4153.         mx,my: integer;
  4154.  
  4155.     begin
  4156.         if Attr.gemHandle<0 then exit;
  4157.         wind_get(Attr.gemHandle,WF_FULLXYWH,Full.X,Full.Y,Full.W,Full.H);
  4158.         GRtoA2(Full);
  4159.         Calc(WC_WORK,Full,r);
  4160.         GetWorkMax(mx,my);
  4161.         if (r.W>mx) or (r.H>my) then
  4162.             begin
  4163.                 if r.W>mx then r.W:=mx;
  4164.                 if r.H>my then r.H:=my;
  4165.                 Calc(WC_BORDER,r,Full);
  4166.                 Full.X:=Curr.X;
  4167.                 Full.Y:=Curr.Y;
  4168.                 if Full.X+Full.W-1>DRect.X2 then
  4169.                     begin
  4170.                         Full.X:=DRect.X2+1-Full.W;
  4171.                         if Full.X<DRect.X then Full.X:=DRect.X
  4172.                     end;
  4173.                 if Full.Y+Full.H-1>DRect.Y2 then
  4174.                     begin
  4175.                         Full.Y:=DRect.Y2+1-Full.H;
  4176.                         if Full.Y<DRect.Y then Full.Y:=DRect.Y
  4177.                     end;
  4178.                 GRtoA2(Full)
  4179.             end;
  4180.         ChkAlign(Full)
  4181.     end;
  4182.  
  4183.  
  4184. procedure TWindow.GetCurr;
  4185.  
  4186.     begin
  4187.         if Attr.gemHandle>=0 then
  4188.             begin
  4189.                 wind_get(Attr.gemHandle,WF_CURRXYWH,Curr.X,Curr.Y,Curr.W,Curr.H);
  4190.                 GRtoA2(Curr)
  4191.             end
  4192.     end;
  4193.  
  4194.  
  4195. procedure TWindow.GetWork;
  4196.  
  4197.     begin
  4198.         if Attr.gemHandle>=0 then
  4199.             begin
  4200.                 wind_get(Attr.gemHandle,WF_WORKXYWH,Work.X,Work.Y,Work.W,Work.H);
  4201.                 if not(IsIconified) then
  4202.                     begin
  4203.                         if Class.ToolbarTree<>nil then
  4204.                             with Class.ToolbarTree^[ROOT] do
  4205.                                 begin
  4206.                                     if ob_width>ob_height then
  4207.                                         begin
  4208.                                             if not(bTst(Class.Style,cs_ToolbarOpposite)) then inc(Work.Y,ob_height-1);
  4209.                                             dec(Work.H,ob_height-1)
  4210.                                         end
  4211.                                     else
  4212.                                         begin
  4213.                                             if not(bTst(Class.Style,cs_ToolbarOpposite)) then inc(Work.X,ob_width-1);
  4214.                                             dec(Work.W,ob_width-1)
  4215.                                         end
  4216.                                 end;
  4217.                         if Class.MenuTree<>nil then
  4218.                             with Class.MenuTree^[Class.MenuTree^[ROOT].ob_head] do
  4219.                                 begin
  4220.                                     inc(Work.Y,ob_height+1);
  4221.                                     dec(Work.H,ob_height+1)
  4222.                                 end
  4223.                     end;
  4224.                 GRtoA2(Work)
  4225.             end
  4226.     end;
  4227.  
  4228.  
  4229. procedure TWindow.SetCurr(r: GRECT);
  4230.  
  4231.     begin
  4232.         WMSized(r.X,r.Y,r.W,r.H)
  4233.     end;
  4234.  
  4235.  
  4236. procedure TWindow.SetWork(r: GRECT);
  4237.     var ro: GRECT;
  4238.  
  4239.     begin
  4240.         Calc(WC_BORDER,r,ro);
  4241.         WMSized(ro.X,ro.Y,ro.W,ro.H)
  4242.     end;
  4243.  
  4244.  
  4245. procedure TWindow.LoadIcon(Icn: PIcon);
  4246.  
  4247.     begin
  4248.         if (Icon=nil) and (Icn<>nil) then
  4249.             begin
  4250.                 Icon:=Icn;
  4251.                 Icon^.Hide(false);
  4252.                 if IsIconified then Icon^.Unhide
  4253.             end
  4254.     end;
  4255.  
  4256.  
  4257. procedure TWindow.FreeIcon;
  4258.  
  4259.     begin
  4260.         if Icon<>nil then
  4261.             begin
  4262.                 if IsIconified then Icon^.Hide(true);
  4263.                 dispose(Icon,Done);
  4264.                 Icon:=nil
  4265.             end
  4266.     end;
  4267.  
  4268.  
  4269. procedure TWindow.LoadMenu(Indx: integer);
  4270.     var tp : PTree;
  4271.         q,l: integer;
  4272.  
  4273.     procedure nextentry(const e,s: string; disable: boolean);
  4274.  
  4275.         begin
  4276.             with Class do    
  4277.                 begin
  4278.                     q:=MenuTree^[q].ob_next;
  4279.                     with MenuTree^[q] do
  4280.                         begin
  4281.                             ob_spec.free_string:=ChrNew('  '+e+StrPSpace(l-3-length(s)-length(e))+s+' ');
  4282.                             if disable then ob_state:=ob_state or DISABLED
  4283.                         end
  4284.                 end
  4285.         end;
  4286.  
  4287.     begin
  4288.         tp:=Application^.GetAddr(Indx);
  4289.         if (Class.MenuTree=nil) and (tp<>nil) then
  4290.             begin
  4291.                 if Application^.MenuCorrect(tp,mnsize) then
  4292.                     begin
  4293.                         getmem(Class.MenuTree,mnsize*sizeof(AESOBJECT));
  4294.                         if Class.MenuTree=nil then
  4295.                             begin
  4296.                                 Application^.Err:=em_InvalidMenu;
  4297.                                 exit
  4298.                             end;
  4299.                         for q:=0 to mnsize-1 do Class.MenuTree^[q]:=tp^[q];
  4300.                         with Class.MenuTree^[ROOT] do
  4301.                             begin
  4302.                                 q:=Class.MenuTree^[Class.MenuTree^[Class.MenuTree^[ob_tail].ob_head].ob_head].ob_next;
  4303.                                 l:=StrLen(Class.MenuTree^[q].ob_spec.free_string);
  4304.                               if (Application^.Attr.Country=FRG) or (Application^.Attr.Country=SWG) then
  4305.                                   begin
  4306.                                         nextentry('Wechseln','^W',false);
  4307.                                         nextentry('Volle Größe','^*',not(bTst(Attr.Style,FULLER)));
  4308.                                         nextentry('Ikonifizieren','^3',(icfserver=nil));
  4309.                                         nextentry('Hintergrund','^/',not(agi.Backdrop))
  4310.                                     end
  4311.                                 else
  4312.                                     begin
  4313.                                         nextentry('Cycle','^W',false);
  4314.                                         nextentry('Maximize','^*',not(bTst(Attr.Style,FULLER)));
  4315.                                         nextentry('Iconify','^3',(icfserver=nil));
  4316.                                         nextentry('Backdrop','^/',not(agi.Backdrop))
  4317.                                     end;
  4318.                                 Class.MenuTree^[Class.MenuTree^[ob_tail].ob_head].ob_tail:=q;
  4319.                                 Class.MenuTree^[q].ob_next:=Class.MenuTree^[ob_tail].ob_head;
  4320.                                 with Class.MenuTree^[Class.MenuTree^[ob_tail].ob_head] do ob_height:=(ob_height shr 3)*6;
  4321.                                 with Class.MenuTree^[Class.MenuTree^[ob_head].ob_head] do ob_width:=Application^.Attr.MaxPX+1;
  4322.                                 with Class.MenuTree^[ob_tail] do
  4323.                                     begin
  4324.                                         ob_x:=0;
  4325.                                         ob_y:=0
  4326.                                     end
  4327.                             end;
  4328.                         GetWork;
  4329.                         if Attr.Status=ws_Open then ForceRedraw
  4330.                     end
  4331.                 else
  4332.                     Application^.Err:=em_InvalidMenu
  4333.             end
  4334.         else
  4335.             Application^.Err:=em_InvalidMenu
  4336.     end;
  4337.  
  4338.  
  4339. procedure TWindow.FreeMenu;
  4340.     var q,i: integer;
  4341.  
  4342.     procedure freenext;
  4343.  
  4344.         begin
  4345.             q:=Class.MenuTree^[q].ob_next;
  4346.             ChrDispose(PChar(Class.MenuTree^[q].ob_spec.free_string))
  4347.         end;
  4348.  
  4349.     begin
  4350.         if Class.MenuTree<>nil then
  4351.             begin
  4352.                 q:=Class.MenuTree^[Class.MenuTree^[Class.MenuTree^[Class.MenuTree^[ROOT].ob_tail].ob_head].ob_head].ob_next;
  4353.                 for i:=0 to 3 do freenext;
  4354.                 freemem(Class.MenuTree,mnsize*sizeof(AESOBJECT));
  4355.                 Class.MenuTree:=nil
  4356.             end;
  4357.         GetWork;
  4358.         if Attr.Status=ws_Open then ForceRedraw
  4359.     end;
  4360.  
  4361.  
  4362. procedure TWindow.LoadToolbar(Indx: integer; Opposite: boolean);
  4363.     var tp: PTree;
  4364.  
  4365.     begin
  4366.         tp:=Application^.GetAddr(Indx);
  4367.         if (Class.ToolbarTree=nil) and (tp<>nil) then
  4368.             begin
  4369.                 Class.ToolbarTree:=tp;
  4370.                 tbtree:=Indx;
  4371.                 if Opposite then
  4372.                     Class.Style:=Class.Style or cs_ToolbarOpposite or cs_FullRedraw
  4373.                 else
  4374.                     Class.Style:=Class.Style and not(cs_ToolbarOpposite);
  4375.                 with Class.ToolbarTree^[ROOT] do
  4376.                     begin
  4377.                         if bTst(Application^.Attr.Style,as_3DFlags) then ob_flags:=ob_flags or FL3DBAK
  4378.                         else
  4379.                             ob_flags:=ob_flags and not(FL3DBAK);
  4380.                         if ob_height>ob_width then
  4381.                             begin
  4382.                                 tbsize:=ob_height;
  4383.                                 ob_height:=Application^.Attr.MaxPY
  4384.                              end
  4385.                         else
  4386.                             begin
  4387.                                 tbsize:=ob_width;
  4388.                                 ob_width:=Application^.Attr.MaxPX
  4389.                             end
  4390.                     end;
  4391.                 GetWork;
  4392.                 if Attr.Status=ws_Open then ForceRedraw
  4393.             end
  4394.         else
  4395.             Application^.Err:=em_InvalidToolbar
  4396.     end;
  4397.  
  4398.  
  4399. procedure TWindow.FreeToolbar;
  4400.  
  4401.     begin
  4402.         with Class do
  4403.             begin
  4404.                 if ToolbarTree<>nil then
  4405.                     begin
  4406.                         with ToolbarTree^[ROOT] do
  4407.                             begin
  4408.                                 if ob_height>ob_width then ob_height:=tbsize
  4409.                                 else
  4410.                                     ob_width:=tbsize
  4411.                             end
  4412.                     end;
  4413.                 ToolbarTree:=nil;
  4414.                 Style:=Style and not(cs_ToolbarOpposite)
  4415.             end;
  4416.         tbtree:=-1;
  4417.         GetWork;
  4418.         if Attr.Status=ws_Open then ForceRedraw
  4419.     end;
  4420.  
  4421.  
  4422. procedure TWindow.LoadDialog(Indx: integer);
  4423.     var tp: PTree;
  4424.  
  4425.     begin
  4426.         tp:=Application^.GetAddr(Indx);
  4427.         if (DlgTree=nil) and (tp<>nil) then
  4428.             begin
  4429.                 SetDlgTree(tp);
  4430.                 if Attr.Status=ws_Open then ForceRedraw
  4431.             end
  4432.         else
  4433.             Application^.Err:=em_InvalidDialog
  4434.     end;
  4435.  
  4436.  
  4437. procedure TWindow.FreeDialog;
  4438.  
  4439.     begin
  4440.         SetDlgTree(nil);
  4441.         if Attr.Status=ws_Open then ForceRedraw
  4442.     end;
  4443.  
  4444.  
  4445. procedure TWindow.SetDlgTree(tree: PTree);
  4446.  
  4447.     begin
  4448.         DlgTree:=tree
  4449.     end;
  4450.  
  4451.  
  4452. procedure TWindow.UpdateDialog;
  4453.     var x,y,w,h: integer;
  4454.  
  4455.     begin
  4456.         if not(IsIconified) then
  4457.             begin
  4458.                 wind_get(Attr.gemHandle,WF_WORKXYWH,x,y,w,h);
  4459.                 if Class.MenuTree<>nil then
  4460.                     with Class.MenuTree^[Class.MenuTree^[ROOT].ob_head] do
  4461.                         begin
  4462.                             ob_x:=x-1;
  4463.                             ob_y:=y;
  4464.                             inc(y,ob_height+1);
  4465.                             dec(h,ob_height+1)
  4466.                         end;
  4467.                 if Class.ToolbarTree<>nil then
  4468.                     with Class.ToolbarTree^[ROOT] do
  4469.                         if bTst(Class.Style,cs_ToolbarOpposite) then
  4470.                             begin
  4471.                                 if ob_width>ob_height then
  4472.                                     begin
  4473.                                         ob_x:=x-1;
  4474.                                         ob_y:=y+h+1-ob_height
  4475.                                     end
  4476.                                 else
  4477.                                     begin
  4478.                                         ob_x:=x+w+1-ob_width;
  4479.                                         ob_y:=y-1
  4480.                                     end
  4481.                             end
  4482.                         else
  4483.                             begin
  4484.                                 ob_x:=x-1;
  4485.                                 ob_y:=y-1
  4486.                             end
  4487.             end;
  4488.         if DlgTree<>nil then
  4489.             with DlgTree^[ROOT] do
  4490.                 begin
  4491.                     if bTst(ob_state,OUTLINED) then
  4492.                         begin
  4493.                             ob_x:=Work.X+outlwidth;
  4494.                             ob_y:=Work.Y+outlwidth
  4495.                         end
  4496.                     else
  4497.                         begin
  4498.                             ob_x:=Work.X;
  4499.                             ob_y:=Work.Y
  4500.                         end
  4501.                 end
  4502.     end;
  4503.  
  4504.  
  4505. procedure TWindow.SetupSize;
  4506.  
  4507.     begin
  4508.         Full:=DRect;
  4509.         Curr:=Full;
  4510.         Calc(WC_WORK,Curr,Work)
  4511.     end;
  4512.  
  4513.  
  4514. procedure TWindow.SetupWindow;
  4515.  
  4516.     begin
  4517.         SetupSize;
  4518.         if AppFlag then
  4519.             if bTst(Class.Style,cs_AutoOpen) then MakeWindow
  4520.     end;
  4521.  
  4522.  
  4523. procedure TWindow.ShutdownWindow;
  4524.  
  4525.     begin
  4526.     end;
  4527.  
  4528.  
  4529. procedure TWindow.MakeWindow;
  4530.  
  4531.     begin
  4532.         Create;
  4533.         OpenWindow
  4534.     end;
  4535.  
  4536.  
  4537. procedure TWindow.Create;
  4538.  
  4539.     begin
  4540.         if Attr.Status=ws_NoWindow then
  4541.             begin
  4542.               if Parent<>nil then
  4543.                   if Parent^.IsDialog then
  4544.                       if PDialog(Parent)^.IsModal then exit;
  4545.                 Attr.gemHandle:=wind_create(Attr.Style,Full.X,Full.Y,Full.W,Full.H);
  4546.                 if Attr.gemHandle<0 then Application^.Err:=em_InvalidWindow
  4547.                 else
  4548.                     begin
  4549.                         Attr.Status:=ws_Created;
  4550.                         if bTst(Attr.Style,NAME) then
  4551.                             wind_set(Attr.gemHandle,WF_NAME,integer(HiWord(@Attr.Title^[1])),integer(LoWord(@Attr.Title^[1])),0,0);
  4552.                         if bTst(Attr.Style,INFO) then
  4553.                             wind_set(Attr.gemHandle,WF_INFO,integer(HiWord(@Attr.SubTitle^[1])),integer(LoWord(@Attr.SubTitle^[1])),0,0);
  4554.                         if agi.BEvent then
  4555.                             begin
  4556.                                 if bTst(Class.Style,cs_WorkBackground) then
  4557.                                     wind_set(Attr.gemHandle,WF_BEVENT,1,0,0,0)
  4558.                                 else
  4559.                                     wind_set(Attr.gemHandle,WF_BEVENT,0,0,0,0)
  4560.                             end;
  4561.                         CreateChildren
  4562.                     end
  4563.             end
  4564.         else
  4565.             CreateChildren
  4566.     end;
  4567.  
  4568.  
  4569. procedure TWindow.CreateChildren;
  4570.     var p: PWindow;
  4571.  
  4572.     begin
  4573.         p:=ChildList;
  4574.         while (p<>nil) do
  4575.             with p^ do
  4576.                 begin
  4577.                     if bTst(Class.Style,cs_AutoCreate) then Create;
  4578.                     p:=Nxt
  4579.                 end
  4580.     end;
  4581.  
  4582.  
  4583. procedure TWindow.OpenWindow;
  4584.     var p: PWindow;
  4585.  
  4586.     begin
  4587.         if Attr.Status=ws_Created then
  4588.             begin
  4589.                 wind_update(BEG_UPDATE);
  4590.                 ChkAlign(Curr);
  4591.                 ChkSize(Curr);
  4592.                 if bTst(Application^.Attr.Style,as_GrowShrink) then form_box(FMD_GROW,Curr);
  4593.                 if wind_open(Attr.gemHandle,Curr.X,Curr.Y,Curr.W,Curr.H)<>0 then
  4594.                     begin
  4595.                         Attr.Status:=ws_Open;
  4596.                         GetWork;
  4597.                         if Scroller<>nil then
  4598.                             with Scroller^ do
  4599.                                 begin
  4600.                                     SetPageSize;
  4601.                                     SetSBarRange
  4602.                                 end;
  4603.                         if bTst(Attr.ExStyle,ws_ex_Disabled) and agi.Backdrop then
  4604.                             wind_set(Attr.gemHandle,WF_BOTTOM,0,0,0,0)
  4605.                         else
  4606.                             EnableCrsWatch;
  4607.                         p:=ChildList;
  4608.                         while (p<>nil) do
  4609.                             with p^ do
  4610.                                 begin
  4611.                                     OpenWindow;
  4612.                                     p:=Nxt
  4613.                                 end
  4614.                     end
  4615.                 else
  4616.                     Application^.Err:=em_WOpenFailure;
  4617.                 wind_update(END_UPDATE)
  4618.             end
  4619.         else
  4620.             if Attr.Status=ws_Open then
  4621.                 begin
  4622.                     if IsDialog then if PDialog(@self)^.IsModal then exit;
  4623.                     if not(bTst(Attr.ExStyle,ws_ex_Disabled)) then Top;
  4624.                     p:=ChildList;
  4625.                     while (p<>nil) do
  4626.                         with p^ do
  4627.                             begin
  4628.                                 OpenWindow;
  4629.                                 p:=Nxt
  4630.                             end
  4631.                 end
  4632.     end;
  4633.  
  4634.  
  4635. procedure TWindow.CloseWindow;
  4636.     var p         : PWindow;
  4637.             ICFFreePos: procedure(d1,d2: pointer; d3,d4,d5: longint; fn,posnr: integer);
  4638.  
  4639.     begin
  4640.         p:=ChildList;
  4641.         while (p<>nil) do
  4642.             with p^ do
  4643.                 begin
  4644.                     CloseWindow;
  4645.                     p:=Nxt
  4646.                 end;
  4647.         if Attr.Status=ws_Open then
  4648.             begin
  4649.                 wind_update(BEG_UPDATE);
  4650.                 GetCurr;
  4651.                 if bTst(Application^.Attr.Style,as_GrowShrink) then form_box(FMD_SHRINK,Curr);
  4652.                 if wind_close(Attr.gemHandle)<>0 then Attr.Status:=ws_Created
  4653.                 else
  4654.                     Application^.Err:=em_WCloseFailure;
  4655.                 if icfpos>=0 then
  4656.                     begin
  4657.                         Curr:=icfcurr;
  4658.                         SetGadgets(icfstyle);
  4659.                         ICFFreePos:=icfserver;
  4660.                         ICFFreePos(nil,nil,0,0,0,ICF_FREEPOS,icfpos);
  4661.                         icfpos:=-1
  4662.                     end;
  4663.                 DisableCrsWatch;
  4664.                 wind_update(END_UPDATE)
  4665.             end
  4666.     end;
  4667.  
  4668.  
  4669. procedure TWindow.Destroy;
  4670.     var p: PWindow;
  4671.  
  4672.     begin
  4673.         p:=ChildList;
  4674.         while (p<>nil) do
  4675.             with p^ do
  4676.                 begin
  4677.                     Destroy;
  4678.                     p:=Nxt
  4679.                 end;
  4680.         if Attr.Status in [ws_Created,ws_Open] then
  4681.             begin
  4682.                 CloseWindow;
  4683.                 if Attr.Status=ws_Created then
  4684.                     begin
  4685.                         if wind_delete(Attr.gemHandle)<>0 then
  4686.                             with Attr do
  4687.                                 begin
  4688.                                     Status:=ws_NoWindow;
  4689.                                     gemHandle:=-1
  4690.                                 end
  4691.                         else
  4692.                             Application^.Err:=em_WDestroyFailure
  4693.                     end
  4694.             end
  4695.     end;
  4696.  
  4697.  
  4698. procedure TWindow.RawDestroy;
  4699.     var p: PWindow;
  4700.             ICFFreePos: procedure(d1,d2: pointer; d3,d4,d5: longint; fn,posnr: integer);
  4701.  
  4702.     begin
  4703.         p:=ChildList;
  4704.         while (p<>nil) do
  4705.             with p^ do
  4706.                 begin
  4707.                     RawDestroy;
  4708.                     p:=Nxt
  4709.                 end;
  4710.         with Attr do
  4711.             begin
  4712.                 DisableCrsWatch;
  4713.                 Status:=ws_NoWindow;
  4714.                 gemHandle:=-1
  4715.             end;
  4716.         if icfpos>=0 then
  4717.             begin
  4718.                 Curr:=icfcurr;
  4719.                 Attr.Style:=icfstyle;
  4720.                 ICFFreePos:=icfserver;
  4721.                 ICFFreePos(nil,nil,0,0,0,ICF_FREEPOS,icfpos);
  4722.                 icfpos:=-1
  4723.             end
  4724.     end;
  4725.  
  4726.  
  4727. procedure TWindow.Top;
  4728.  
  4729.     begin
  4730.         if Attr.Status=ws_Open then
  4731.             begin
  4732.                 wind_update(BEG_UPDATE);
  4733.                 wind_set(Attr.gemHandle,WF_TOP,0,0,0,0);
  4734.                 EnableCrsWatch;
  4735.                 wind_update(END_UPDATE)
  4736.             end
  4737.     end;
  4738.  
  4739.  
  4740. procedure TWindow.FullSize;
  4741.     var r: GRECT;
  4742.  
  4743.     begin
  4744.         if Attr.Status=ws_Open then
  4745.             begin
  4746.                 wind_update(BEG_UPDATE);
  4747.                 GetFull;
  4748.                 wind_get(Attr.gemHandle,WF_CURRXYWH,r.X,r.Y,r.W,r.H);
  4749.                 if (Full.X=r.X) and (Full.Y=r.Y) and (Full.W=r.W) and (Full.H=r.H) then
  4750.                     begin
  4751.                         if bTst(Application^.Attr.Style,as_GrowShrink) then
  4752.                             form_dial(FMD_SHRINK,Curr.X,Curr.Y,Curr.W,Curr.H,Full.X,Full.Y,Full.W,Full.H);
  4753.                         r:=Curr
  4754.                     end
  4755.                 else
  4756.                     begin
  4757.                         if bTst(Application^.Attr.Style,as_GrowShrink) then
  4758.                             form_dial(FMD_GROW,Curr.X,Curr.Y,Curr.W,Curr.H,Full.X,Full.Y,Full.W,Full.H);
  4759.                         r:=Full
  4760.                     end;
  4761.                 wind_set(Attr.gemHandle,WF_CURRXYWH,r.X,r.Y,r.W,r.H);
  4762.                 GetWork;
  4763.                 UpdateDialog;
  4764.                 if bTst(Class.Style,cs_FullRedraw) then ForceRedraw;
  4765.                 wind_update(END_UPDATE)
  4766.             end
  4767.     end;
  4768.  
  4769.  
  4770. procedure TWindow.Size(r: GRECT);
  4771.  
  4772.     begin
  4773.         if Attr.Status=ws_Open then
  4774.             begin
  4775.                 wind_update(BEG_UPDATE);
  4776.                 Curr:=r;
  4777.                 wind_set(Attr.gemHandle,WF_CURRXYWH,r.X,r.Y,r.W,r.H);
  4778.                 GetWork;
  4779.                 UpdateDialog;
  4780.                 if bTst(Class.Style,cs_FullRedraw) then ForceRedraw;
  4781.                 wind_update(END_UPDATE)
  4782.             end
  4783.         else
  4784.             Curr:=r
  4785.     end;
  4786.  
  4787.  
  4788. procedure TWindow.Move(r: GRECT);
  4789.     var chg: boolean;
  4790.  
  4791.     begin
  4792.         if Attr.Status=ws_Open then
  4793.             begin
  4794.                 wind_update(BEG_UPDATE);
  4795.                 chg:=((Curr.W<>r.W) or (Curr.H<>r.H));
  4796.                 Curr:=r;
  4797.                 wind_set(Attr.gemHandle,WF_CURRXYWH,r.X,r.Y,r.W,r.H);
  4798.                 GetWork;
  4799.                 UpdateDialog;
  4800.                 if bTst(Class.Style,cs_FullRedraw) and chg then ForceRedraw;
  4801.                 wind_update(END_UPDATE)
  4802.             end
  4803.         else
  4804.             Curr:=r
  4805.     end;
  4806.  
  4807.  
  4808. procedure TWindow.InitPaint;
  4809.  
  4810.     begin
  4811.     end;
  4812.  
  4813.  
  4814. procedure TWindow.Paint(var PaintInfo: TPaintStruct);
  4815.  
  4816.     begin
  4817.         if DlgTree<>nil then
  4818.             with PaintInfo.rcPaint do objc_draw(DlgTree,ROOT,MAX_DEPTH,X,Y,W,H)
  4819.     end;
  4820.  
  4821.  
  4822. procedure TWindow.IconPaint(var PaintInfo: TPaintStruct);
  4823.  
  4824.     begin
  4825.     end;
  4826.  
  4827.  
  4828. procedure TWindow.ExitPaint;
  4829.  
  4830.     begin
  4831.     end;
  4832.  
  4833.  
  4834. procedure TWindow.ForceRedraw;
  4835.     var pipe: Pipearray;
  4836.         r   : GRECT;
  4837.  
  4838.     begin
  4839.         if Attr.Status=ws_Open then
  4840.             begin
  4841.                 wind_update(BEG_UPDATE);
  4842.                 GetWork;
  4843.                 if bTst(Class.Style,cs_ToolbarOpposite) then
  4844.                     wind_get(Attr.gemHandle,WF_WORKXYWH,r.X,r.Y,r.W,r.H)
  4845.                 else
  4846.                     r:=Work;
  4847.                 pipe[0]:=WM_REDRAW;
  4848.                 pipe[1]:=Application^.apID;
  4849.                 pipe[2]:=0;
  4850.                 pipe[3]:=Attr.gemHandle;
  4851.                 pipe[4]:=r.X;
  4852.                 pipe[5]:=r.Y;
  4853.                 pipe[6]:=r.W;
  4854.                 pipe[7]:=r.H;
  4855.                 appl_write(pipe[1],16,@pipe);
  4856.                 wind_update(END_UPDATE)
  4857.             end
  4858.     end;
  4859.  
  4860.  
  4861. procedure TWindow.SetTitle(ATitle: string);
  4862.  
  4863.     begin
  4864.         DisposeStr(Attr.Title);
  4865.         ATitle:=StrPLeft(StrPTrimF(ATitle),78);
  4866.         if length(Atitle)>0 then ATitle:=' '+ATitle+' ';
  4867.         ATitle:=ATitle+#0;
  4868.         Attr.Title:=NewStr(ATitle);
  4869.       if (Attr.Status in [ws_Created,ws_Open]) then
  4870.           if not(IsIconified) then
  4871.               if bTst(Attr.Style,NAME) then
  4872.                     wind_set(Attr.gemHandle,WF_NAME,integer(HiWord(@Attr.Title^[1])),integer(LoWord(@Attr.Title^[1])),0,0)
  4873.     end;
  4874.  
  4875.  
  4876. procedure TWindow.SetSubTitle(AnInfo: string);
  4877.  
  4878.     begin
  4879.         DisposeStr(Attr.SubTitle);
  4880.         AnInfo:=StrPLeft(AnInfo,80)+#0;
  4881.         if length(AnInfo)=1 then AnInfo:=' '+AnInfo;
  4882.         Attr.SubTitle:=NewStr(AnInfo);
  4883.       if (Attr.Status in [ws_Created,ws_Open]) then
  4884.           if bTst(Attr.Style,INFO) then
  4885.                 wind_set(Attr.gemHandle,WF_INFO,integer(HiWord(@Attr.SubTitle^[1])),integer(LoWord(@Attr.SubTitle^[1])),0,0)
  4886.     end;
  4887.  
  4888.  
  4889. procedure TWindow.SetGadgets(Style: integer);
  4890.     label _error,_open;
  4891.  
  4892.     var wasopen: boolean;
  4893.  
  4894.     begin
  4895.         if Attr.Status=ws_NoWindow then exit;
  4896.         if Style<>Attr.Style then
  4897.             begin
  4898.                 wind_update(BEG_UPDATE);
  4899.                 DisableCrsWatch;
  4900.                 wasopen:=(Attr.Status=ws_Open);
  4901.                 if wasopen then
  4902.                     begin
  4903.                         GetCurr;
  4904.                         if wind_close(Attr.gemHandle)=0 then goto _error
  4905.                     end;
  4906.                 Attr.Status:=ws_Created;
  4907.                 if wind_delete(Attr.gemHandle)=0 then goto _open;
  4908.                 Attr.Style:=Style;
  4909.                 Attr.gemHandle:=wind_create(Attr.Style,Full.X,Full.Y,Full.W,Full.H);
  4910.                 if Attr.gemHandle<0 then
  4911.                     begin
  4912.                         Attr.Status:=ws_NoWindow;
  4913.                         Application^.Err:=em_InvalidWindow;
  4914.                         goto _error
  4915.                     end;
  4916.                 if bTst(Attr.Style,NAME) then
  4917.                     wind_set(Attr.gemHandle,WF_NAME,integer(HiWord(@Attr.Title^[1])),integer(LoWord(@Attr.Title^[1])),0,0);
  4918.                 if bTst(Attr.Style,INFO) then
  4919.                     wind_set(Attr.gemHandle,WF_INFO,integer(HiWord(@Attr.SubTitle^[1])),integer(LoWord(@Attr.SubTitle^[1])),0,0);
  4920.                 if agi.BEvent then
  4921.                     begin
  4922.                         if bTst(Class.Style,cs_WorkBackground) then
  4923.                             wind_set(Attr.gemHandle,WF_BEVENT,1,0,0,0)
  4924.                         else
  4925.                             wind_set(Attr.gemHandle,WF_BEVENT,0,0,0,0)
  4926.                     end;
  4927.                 _open:
  4928.                 if wasopen then
  4929.                     begin
  4930.                         if wind_open(Attr.gemHandle,Curr.X,Curr.Y,Curr.W,Curr.H)<>0 then
  4931.                             begin
  4932.                                 Attr.Status:=ws_Open;
  4933.                                 GetWork;
  4934.                                 if Scroller<>nil then
  4935.                                     with Scroller^ do
  4936.                                         begin
  4937.                                             SetPageSize;
  4938.                                             SetSBarRange
  4939.                                         end;
  4940.                                 if bTst(Attr.ExStyle,ws_ex_Disabled) and agi.Backdrop then
  4941.                                     wind_set(Attr.gemHandle,WF_BOTTOM,0,0,0,0)
  4942.                                 else
  4943.                                     EnableCrsWatch
  4944.                             end
  4945.                         else
  4946.                             Application^.Err:=em_WOpenFailure
  4947.                     end;
  4948.                 _error:
  4949.                 wind_update(END_UPDATE)
  4950.             end
  4951.     end;
  4952.  
  4953.  
  4954. procedure TWindow.SetCursor(Crs: HCursor);
  4955.     var cr       : GRECT;
  4956.         x,y,dummy: integer;
  4957.  
  4958.     begin
  4959.         if IsIconified then
  4960.             begin
  4961.                 Class.hCursor:=Crs;
  4962.                 exit
  4963.             end;
  4964.         wind_update(BEG_UPDATE);
  4965.         Class.hCursor:=Crs;
  4966.         if Application^.pcrswatch=@self then
  4967.             if Crs>id_No then
  4968.                 if not(IsMouseBusy) then
  4969.                     begin
  4970.                         graf_mkstate(x,y,dummy,dummy);
  4971.                         Application^.GetCrsRect(cr);
  4972.                         if Between(x,cr.X1,cr.X2) and Between(y,cr.Y1,cr.Y2) then
  4973.                             begin
  4974.                                 if Crs>$7fff then graf_mouse(USER_DEF,pointer(Crs))
  4975.                                 else
  4976.                                     graf_mouse(Crs,nil)
  4977.                             end
  4978.                     end;
  4979.         wind_update(END_UPDATE)
  4980.     end;
  4981.  
  4982.  
  4983. procedure TWindow.Calc(ctype: integer; ri: GRECT; var ro: GRECT);
  4984.  
  4985.     begin
  4986.         if ctype=WC_BORDER then
  4987.             if not(IsIconified) then
  4988.                 begin
  4989.                     if Class.MenuTree<>nil then
  4990.                         inc(ri.H,Class.MenuTree^[Class.MenuTree^[ROOT].ob_head].ob_height+1);
  4991.                     if Class.ToolbarTree<>nil then
  4992.                         with Class.ToolbarTree^[ROOT] do
  4993.                             begin
  4994.                                 if ob_width>ob_height then
  4995.                                     begin
  4996.                                         if not(bTst(Class.Style,cs_ToolbarOpposite)) then dec(ri.Y,ob_height-1);
  4997.                                         inc(ri.H,ob_height-1)
  4998.                                     end
  4999.                                 else
  5000.                                     begin
  5001.                                         if not(bTst(Class.Style,cs_ToolbarOpposite)) then dec(ri.X,ob_width-1);
  5002.                                         inc(ri.W,ob_width-1)
  5003.                                     end
  5004.                             end
  5005.                 end;
  5006.         wind_calc(ctype,Attr.Style,ri.X,ri.Y,ri.W,ri.H,ro.X,ro.Y,ro.W,ro.H);
  5007.         if ctype=WC_WORK then
  5008.             if not(IsIconified) then
  5009.                 begin
  5010.                     if Class.MenuTree<>nil then
  5011.                         dec(ro.H,Class.MenuTree^[Class.MenuTree^[ROOT].ob_head].ob_height+1);
  5012.                     if Class.ToolbarTree<>nil then
  5013.                         with Class.ToolbarTree^[ROOT] do
  5014.                             begin
  5015.                                 if ob_width>ob_height then
  5016.                                     begin
  5017.                                         if not(bTst(Class.Style,cs_ToolbarOpposite)) then inc(ro.Y,ob_height-1);
  5018.                                         dec(ro.H,ob_height-1)
  5019.                                     end
  5020.                                 else
  5021.                                     begin
  5022.                                         if not(bTst(Class.Style,cs_ToolbarOpposite)) then inc(ro.X,ob_width-1);
  5023.                                         dec(ro.W,ob_width-1)
  5024.                                     end
  5025.                             end
  5026.                 end;
  5027.         GRtoA2(ro)
  5028.     end;
  5029.  
  5030.  
  5031. procedure TWindow.ChkAlign(var r: GRECT);
  5032.     label _fertig;
  5033.  
  5034.     var ro: GRECT;
  5035.  
  5036.     procedure ChkMax(var r: GRECT);
  5037.  
  5038.         begin
  5039.             if r.X+r.W-1>DRect.X2 then r.W:=DRect.X2+1-r.X;
  5040.             if r.Y+r.H-1>DRect.Y2 then r.H:=DRect.Y2+1-r.Y;
  5041.             GRtoA2(r)
  5042.         end;
  5043.  
  5044.     begin
  5045.         if r.Y<DRect.Y then r.Y:=DRect.Y;
  5046.         if IsIconified then goto _fertig;
  5047.         if bTst(Class.Style,cs_ByteAlignClient) then
  5048.             begin
  5049.                 Calc(WC_WORK,r,ro);
  5050.                 ro.X:=(ro.X shr 3) shl 3;
  5051.                 Calc(WC_BORDER,ro,r);
  5052.                 if r.X<DRect.X then
  5053.                     begin
  5054.                         inc(r.X,8);
  5055.                         ChkMax(r)
  5056.                     end
  5057.             end
  5058.         else
  5059.             if bTst(Class.Style,cs_ByteAlignWindow) then
  5060.                 begin
  5061.                     r.X:=(r.X shr 3) shl 3;
  5062.                     if r.X<DRect.X then
  5063.                         begin
  5064.                             inc(r.X,8);
  5065.                             ChkMax(r)
  5066.                         end
  5067.                 end;
  5068.         if bTst(Class.Style,cs_VerAlignClient) then
  5069.             begin
  5070.                 Calc(WC_WORK,r,ro);
  5071.                 ro.Y:=(ro.Y shr 1) shl 1;
  5072.                 Calc(WC_BORDER,ro,r);
  5073.                 if r.Y<DRect.Y then
  5074.                     begin
  5075.                         while r.Y<DRect.Y do inc(r.Y,2);
  5076.                         ChkMax(r)
  5077.                     end
  5078.             end
  5079.         else
  5080.             if bTst(Class.Style,cs_VerAlignWindow) then
  5081.                 begin
  5082.                     r.Y:=(r.Y shr 1) shl 1;
  5083.                     if r.Y<DRect.Y then
  5084.                         begin
  5085.                             while r.Y<DRect.Y do inc(r.Y,2);
  5086.                             ChkMax(r)
  5087.                         end
  5088.                 end;
  5089.         _fertig:
  5090.         GRtoA2(r)
  5091.      end;
  5092.  
  5093.  
  5094. procedure TWindow.ChkSize(var r: GRECT);
  5095.     var ro             : GRECT;
  5096.         mix,miy,mxx,mxy: integer;
  5097.  
  5098.     begin
  5099.         Calc(WC_WORK,r,ro);
  5100.         GetWorkMin(mix,miy);
  5101.         GetWorkMax(mxx,mxy);
  5102.         if (ro.W>mxx) or (ro.H>mxy) then
  5103.             begin
  5104.                 if ro.W>mxx then ro.W:=mxx;
  5105.                 if ro.H>mxy then ro.H:=mxy;
  5106.                 Calc(WC_BORDER,ro,r)
  5107.             end;
  5108.         if (ro.W<mix) or (ro.H<miy) then
  5109.             begin
  5110.                 if ro.W<mix then ro.W:=mix;
  5111.                 if ro.H<miy then ro.H:=miy;
  5112.                 Calc(WC_BORDER,ro,r)
  5113.             end;
  5114.         GRtoA2(r)
  5115.     end;
  5116.  
  5117.  
  5118. procedure TWindow.GetWorkMin(var minX,minY: integer);
  5119.  
  5120.     begin
  5121.         minX:=21;
  5122.         minY:=1
  5123.     end;
  5124.  
  5125.  
  5126. procedure TWindow.GetWorkMax(var maxX,maxY: integer);
  5127.  
  5128.     begin
  5129.         maxX:=maxint;
  5130.         maxY:=maxint
  5131.     end;
  5132.  
  5133.  
  5134. function TWindow.GetDC: integer;
  5135.     var box: GRECT;
  5136.  
  5137.     begin
  5138.         GetDC:=-1;
  5139.         wind_update(BEG_UPDATE);
  5140.         if FirstWorkRect(box) then
  5141.             begin
  5142.                 HideMouse;
  5143.                 vs_clip(vdiHandle,CLIP_ON,box.A2);
  5144.                 GetDC:=vdiHandle
  5145.             end
  5146.         else
  5147.             wind_update(END_UPDATE)
  5148.     end;
  5149.  
  5150.  
  5151. procedure TWindow.ReleaseDC;
  5152.  
  5153.     begin
  5154.         vs_clip(vdiHandle,CLIP_ON,DRect.A2);
  5155.         ShowMouse;
  5156.         wind_update(END_UPDATE)
  5157.     end;
  5158.  
  5159.  
  5160. procedure TWindow.MNSelected(meNum,mtNum: integer; Tree: PTree; PrIndx: integer);
  5161.     var found: boolean;
  5162.         p    : PEvent;
  5163.  
  5164.     begin
  5165.         found:=false;
  5166.         p:=EventList;
  5167.         while (p<>nil) and not(found) do
  5168.             with p^ do
  5169.                 begin
  5170.                     found:=TestMenu(meNum);
  5171.                     p:=Nxt
  5172.                 end;
  5173.         if not(found) then HandleMenu(meNum)
  5174.     end;
  5175.  
  5176.  
  5177. procedure TWindow.HandleMenu(meNum: integer);
  5178.  
  5179.     begin
  5180.         if meNum=Class.MenuTree^[Class.MenuTree^[Class.MenuTree^[ROOT].ob_tail].ob_head].ob_head then
  5181.             with Application^ do
  5182.                 if MenuTree<>nil then
  5183.                     MNSelected(MenuTree^[MenuTree^[MenuTree^[ROOT].ob_tail].ob_head].ob_head,MenuTree^[MenuTree^[MenuTree^[ROOT].ob_head].ob_head].ob_head,nil,0)
  5184.     end;
  5185.  
  5186.  
  5187. procedure TWindow.WMRedraw(X,Y,W,H: integer);
  5188.     var box,area   : GRECT;
  5189.         PaintInfo  : TPaintStruct;
  5190.         icn,visible: boolean;
  5191.         pe         : PEvent;
  5192.  
  5193.     begin
  5194.         if Attr.Status<>ws_Open then exit;
  5195.         area.X:=X;
  5196.         area.Y:=Y;
  5197.         area.W:=W;
  5198.         area.H:=H;
  5199.         HideMouse;
  5200.         icn:=IsIconified;
  5201.         UpdateDialog;
  5202.         if Class.MenuTree<>nil then
  5203.             if not(icn) then
  5204.                 begin
  5205.                     gem.vswr_mode(vdiHandle,MD_REPLACE);
  5206.                     gem.vsl_color(vdiHandle,Black);
  5207.                     gem.vsl_width(vdiHandle,1);
  5208.                     gem.vsl_ends(vdiHandle,LE_SQUARED,LE_SQUARED);
  5209.                     gem.vsl_type(vdiHandle,LT_SOLID);
  5210.                     wind_get(Attr.gemHandle,WF_WORKXYWH,box.X,box.Y,box.W,box.H);
  5211.                     pxya[0]:=box.X;
  5212.                     pxya[1]:=box.Y+Class.MenuTree^[Class.MenuTree^[ROOT].ob_head].ob_height;
  5213.                     pxya[2]:=box.X+box.W;
  5214.                     pxya[3]:=pxya[1];
  5215.                     wind_get(Attr.gemHandle,WF_FIRSTXYWH,box.X,box.Y,box.W,box.H);
  5216.                     while (box.W>0) and (box.H>0) do
  5217.                         begin
  5218.                             if rc_intersect(DRect,box) then
  5219.                                 if rc_intersect(area,box) then
  5220.                                     with box do
  5221.                                         begin
  5222.                                             objc_draw(Class.MenuTree,Class.MenuTree^[ROOT].ob_head,MAX_DEPTH,X,Y,W,H);
  5223.                                             vs_clip(vdiHandle,CLIP_ON,A2);
  5224.                                             v_pline(vdiHandle,2,pxya)
  5225.                                         end;
  5226.                             wind_get(Attr.gemHandle,WF_NEXTXYWH,box.X,box.Y,box.W,box.H)
  5227.                         end;
  5228.                     vs_clip(vdiHandle,CLIP_ON,DRect.A2);
  5229.                     gem.vswr_mode(vdiHandle,GP.wrmode);
  5230.                     gem.vsl_color(vdiHandle,GP.lcolor);
  5231.                     gem.vsl_width(vdiHandle,GP.lwidth);
  5232.                     gem.vsl_ends(vdiHandle,GP.lendsb,GP.lendse);
  5233.                     gem.vsl_type(vdiHandle,GP.ltype)
  5234.                 end;
  5235.         if Class.ToolbarTree<>nil then
  5236.             if not(icn) then
  5237.                 begin
  5238.                     wind_get(Attr.gemHandle,WF_FIRSTXYWH,box.X,box.Y,box.W,box.H);
  5239.                     while (box.W>0) and (box.H>0) do
  5240.                         begin
  5241.                             if rc_intersect(DRect,box) then
  5242.                                 if rc_intersect(area,box) then
  5243.                                     with box do objc_draw(Class.ToolbarTree,ROOT,MAX_DEPTH,X,Y,W,H);
  5244.                             wind_get(Attr.gemHandle,WF_NEXTXYWH,box.X,box.Y,box.W,box.H)
  5245.                         end
  5246.                 end;
  5247.         visible:=FirstWorkRect(box);
  5248.         InitPaint;
  5249.         while visible do
  5250.             begin
  5251.                 if rc_intersect(area,box) then
  5252.                     begin
  5253.                         vs_clip(vdiHandle,CLIP_ON,box.A2);
  5254.                         with PaintInfo do
  5255.                             begin
  5256.                                 rcPaint:=box;
  5257.                                 if icn then feColor:=IconClass.hbrBackground
  5258.                                 else
  5259.                                     feColor:=Class.hbrBackground;
  5260.                                 dec(feColor);
  5261.                                 if feColor>=0 then
  5262.                                     begin
  5263.                                         fErase:=true;
  5264.                                         gem.vswr_mode(vdiHandle,MD_REPLACE);
  5265.                                         gem.vsf_interior(vdiHandle,FIS_SOLID);
  5266.                                         gem.vsf_color(vdiHandle,feColor);
  5267.                                         vr_recfl(vdiHandle,rcPaint.A2);
  5268.                                         gem.vswr_mode(vdiHandle,GP.wrmode);
  5269.                                         gem.vsf_interior(vdiHandle,GP.finterior);
  5270.                                         gem.vsf_color(vdiHandle,GP.fcolor)
  5271.                                     end
  5272.                                 else
  5273.                                     fErase:=false
  5274.                             end;
  5275.                         if icn then IconPaint(PaintInfo)
  5276.                         else
  5277.                             Paint(PaintInfo)
  5278.                     end;
  5279.                 visible:=NextWorkRect(box)
  5280.             end;
  5281.         ExitPaint;
  5282.         if not(icn) then
  5283.             begin
  5284.                 pe:=EventList;
  5285.                 while pe<>nil do
  5286.                     begin
  5287.                         if bTst(pe^.Style,es_Icon) then PIcon(pe)^.Paint;
  5288.                         pe:=pe^.Next
  5289.                     end
  5290.             end
  5291.         else
  5292.             if Icon<>nil then
  5293.                 begin
  5294.                     Icon^.SetPos((Work.W-Icon^.VObj.ob_width) shr 1,(Work.H-Icon^.VObj.ob_height) shr 1,false);
  5295.                     Icon^.Unhide;
  5296.                     Icon^.Hide(false)
  5297.                 end;
  5298.         vs_clip(vdiHandle,CLIP_ON,DRect.A2);
  5299.         ShowMouse
  5300.     end;
  5301.  
  5302.  
  5303. procedure TWindow.WMTopped;
  5304.  
  5305.     begin
  5306.         Top
  5307.     end;
  5308.  
  5309.  
  5310. procedure TWindow.WMClosed;
  5311.  
  5312.     begin
  5313.         if CanClose then
  5314.             begin
  5315.                 Application^.ChkError;
  5316.                 Destroy;
  5317.                 if bTst(Class.Style,cs_QuitOnClose) then
  5318.                     with Application^ do if ChkError>=em_OutOfMemory then Quit
  5319.             end
  5320.     end;
  5321.  
  5322.  
  5323. procedure TWindow.WMFulled;
  5324.  
  5325.     begin
  5326.         FullSize;
  5327.         if Scroller<>nil then
  5328.             with Scroller^ do
  5329.                 begin
  5330.                     SetPageSize;
  5331.                     SetSBarRange
  5332.                 end
  5333.     end;
  5334.  
  5335.  
  5336. procedure TWindow.WMArrowed(waA,SpeedA,waB,SpeedB: integer);
  5337.     var scrollx,scrolly: longint;
  5338.  
  5339.     begin
  5340.         if Scroller=nil then exit;
  5341.         scrollx:=0;
  5342.         scrolly:=0;
  5343.         case waA of
  5344.             WA_UPPAGE: scrolly:=-SpeedA*Scroller^.YPage;
  5345.             WA_DNPAGE: scrolly:=SpeedA*Scroller^.YPage;
  5346.             WA_UPLINE: scrolly:=-SpeedA*Scroller^.YLine;
  5347.             WA_DNLINE: scrolly:=SpeedA*Scroller^.YLine;
  5348.             WA_LFPAGE: scrollx:=-SpeedA*Scroller^.XPage;
  5349.             WA_RTPAGE: scrollx:=SpeedA*Scroller^.XPage;
  5350.             WA_LFLINE: scrollx:=-SpeedA*Scroller^.XLine;
  5351.             WA_RTLINE: scrollx:=SpeedA*Scroller^.XLine
  5352.         end;
  5353.         if waB>0 then
  5354.             case waB of
  5355.                 WA_UPPAGE: dec(scrolly,SpeedB*Scroller^.YPage);
  5356.                 WA_DNPAGE: inc(scrolly,SpeedB*Scroller^.YPage);
  5357.                 WA_UPLINE: dec(scrolly,SpeedB*Scroller^.YLine);
  5358.                 WA_DNLINE: inc(scrolly,SpeedB*Scroller^.YLine);
  5359.                 WA_LFPAGE: dec(scrollx,SpeedB*Scroller^.XPage);
  5360.                 WA_RTPAGE: inc(scrollx,SpeedB*Scroller^.XPage);
  5361.                 WA_LFLINE: dec(scrollx,SpeedB*Scroller^.XLine);
  5362.                 WA_RTLINE: inc(scrollx,SpeedB*Scroller^.XLine)
  5363.             end;
  5364.         Scroller^.ScrollBy(scrollx,scrolly)
  5365.     end;
  5366.  
  5367.  
  5368. procedure TWindow.WMHSlid(Value: integer);
  5369.     var dif: longint;
  5370.  
  5371.     begin
  5372.         if Scroller<>nil then
  5373.             with Scroller^ do
  5374.                 begin
  5375.                     dif:=XRange-XPage-1;
  5376.                     if dif<1 then dif:=1;
  5377.                     ScrollTo((Value*dif) div 1000,YPos)
  5378.                 end
  5379.     end;
  5380.  
  5381.  
  5382. procedure TWindow.WMVSlid(Value: integer);
  5383.     var dif: longint;
  5384.  
  5385.     begin
  5386.         if Scroller<>nil then
  5387.             with Scroller^ do
  5388.                 begin
  5389.                     dif:=YRange-YPage-1;
  5390.                     if dif<1 then dif:=1;
  5391.                     ScrollTo(XPos,(Value*dif) div 1000)
  5392.                 end
  5393.     end;
  5394.  
  5395.  
  5396. procedure TWindow.WMSized(X,Y,W,H: integer);
  5397.     var r: GRECT;
  5398.  
  5399.     begin
  5400.         r.X:=X;
  5401.         r.Y:=Y;
  5402.         r.W:=W;
  5403.         r.H:=H;
  5404.         ChkAlign(r);
  5405.         ChkSize(r);
  5406.         Size(r);
  5407.         if Scroller<>nil then
  5408.             with Scroller^ do
  5409.                 begin
  5410.                     SetPageSize;
  5411.                     SetSBarRange
  5412.                 end
  5413.     end;
  5414.  
  5415.  
  5416. procedure TWindow.WMMoved(X,Y,W,H: integer);
  5417.     var r: GRECT;
  5418.  
  5419.     begin
  5420.         r.X:=X;
  5421.         r.Y:=Y;
  5422.         r.W:=W;
  5423.         r.H:=H;
  5424.         ChkAlign(r);
  5425.         ChkSize(r);
  5426.         Move(r);
  5427.         if Scroller<>nil then
  5428.             with Scroller^ do
  5429.                 begin
  5430.                     SetPageSize;
  5431.                     SetSBarRange
  5432.                 end
  5433.     end;
  5434.  
  5435.  
  5436. procedure TWindow.WMButton(mX,mY,BStat,KStat,Clicks: integer);
  5437.     var r    : GRECT;
  5438.         valid: boolean;
  5439.  
  5440.     begin
  5441.         if BStat=1 then
  5442.             begin
  5443.                 if Clicks=1 then
  5444.                     begin
  5445.                         valid:=true;
  5446.                         if bTst(Class.Style,cs_Rubbox) then
  5447.                             begin
  5448.                                 r.X:=Work.X+Attr.RBox.X1;
  5449.                                 r.Y:=Work.Y+Attr.RBox.Y1;
  5450.                                 r.W:=Work.W-Attr.RBox.X2;
  5451.                                 r.H:=Work.H-Attr.RBox.Y2;
  5452.                                 if (r.W>0) and (r.H>0) then
  5453.                                     if rc_intersect(Work,r) then
  5454.                                         if (mX>=r.X1) and (mX<=r.X2) and (mY>=r.Y1) and (mY<=r.Y2) then
  5455.                                             begin
  5456.                                                 valid:=false;
  5457.                                                 if (KStat and K_SHIFT)>0 then Application^.IconSelect(false,Attr.gemHandle)
  5458.                                                 else
  5459.                                                     Application^.IconSelect(false,id_No);
  5460.                                                 if Application^.Rubbox(Attr.gemHandle,mX,mY,r.X1,r.Y1,r.X2,r.Y2,true,r) then WMRubbox(r)
  5461.                                             end
  5462.                             end;
  5463.                         if valid then WMClick(mX,mY,KStat)
  5464.                     end
  5465.                 else
  5466.                     if Clicks=2 then
  5467.                         if bTst(Class.Style,cs_DblClks) then WMDblClick(mX,mY,KStat)
  5468.             end
  5469.         else
  5470.             if BStat=2 then
  5471.                 begin
  5472.                     if Clicks=2 then Top
  5473.                     else
  5474.                         WMRButton(mX,mY,KStat,Clicks)
  5475.                 end
  5476.     end;
  5477.  
  5478.  
  5479. procedure TWindow.WMClick(mX,mY,KStat: integer);
  5480.  
  5481.     begin
  5482.         if (KStat and K_SHIFT)>0 then Application^.IconSelect(false,Attr.gemHandle)
  5483.         else
  5484.             Application^.IconSelect(false,id_No)
  5485.     end;
  5486.  
  5487.  
  5488. procedure TWindow.WMDblClick(mX,mY,KStat: integer);
  5489.  
  5490.     begin
  5491.         if (KStat and K_SHIFT)>0 then Application^.IconSelect(false,Attr.gemHandle)
  5492.         else
  5493.             Application^.IconSelect(false,id_No)
  5494.     end;
  5495.  
  5496.  
  5497. procedure TWindow.WMRButton(mX,mY,KStat,Clicks: integer);
  5498.  
  5499.     begin
  5500.     end;
  5501.  
  5502.  
  5503. procedure TWindow.WMRubbox(r: GRECT);
  5504.  
  5505.     begin
  5506.     end;
  5507.  
  5508.  
  5509. procedure TWindow.WMRBoxChanged(r: GRECT);
  5510.  
  5511.     begin
  5512.     end;
  5513.  
  5514.  
  5515. procedure TWindow.WMRBoxCheck(x,y,xmin,ymin,xmax,ymax: integer; var mx,my: integer);
  5516.  
  5517.     begin
  5518.     end;
  5519.  
  5520.  
  5521. procedure TWindow.WMNewTop;
  5522.  
  5523.     begin
  5524.         WMUntopped
  5525.     end;
  5526.  
  5527.  
  5528. procedure TWindow.WMUntopped;
  5529.  
  5530.     begin
  5531.         DisableCrsWatch
  5532.     end;
  5533.  
  5534.  
  5535. procedure TWindow.WMOnTop;
  5536.  
  5537.     begin
  5538.         EnableCrsWatch
  5539.     end;
  5540.  
  5541.  
  5542. procedure TWindow.WMBottomed;
  5543.  
  5544.     begin
  5545.         if (Attr.Status=ws_Open) and agi.Backdrop then
  5546.             begin
  5547.                 wind_set(Attr.gemHandle,WF_BOTTOM,0,0,0,0);
  5548.                 DisableCrsWatch
  5549.             end
  5550.     end;
  5551.  
  5552.  
  5553. procedure TWindow.WMToolbar(Indx,BStat,KStat,Clicks: integer);
  5554.     label _fertig;
  5555.  
  5556.     var p             : PEvent;
  5557.         pe            : PToolbar;
  5558.         oadr          : PObj;
  5559.         pipe          : Pipearray;
  5560.         dummy,bx,by,bs: integer;
  5561.         brect,mrect   : GRECT;
  5562.         onbtn,inrect  : boolean;
  5563.  
  5564.     procedure CheckAndDraw(CheckFlag: integer);
  5565.         var box: GRECT;
  5566.  
  5567.         begin
  5568.             with oadr^ do
  5569.                 if CheckFlag=bf_Unchecked then ob_state:=ob_state and not(SELECTED)
  5570.                 else
  5571.                     ob_state:=ob_state or SELECTED;
  5572.             wind_update(BEG_UPDATE);
  5573.             HideMouse;
  5574.             wind_get(Attr.gemHandle,WF_FIRSTXYWH,box.X,box.Y,box.W,box.H);
  5575.             while (box.W>0) and (box.H>0) do
  5576.                 begin
  5577.                     if rc_intersect(DRect,box) then
  5578.                         with box do objc_draw(Class.ToolbarTree,Indx,MAX_DEPTH,X,Y,W,H);
  5579.                     wind_get(Attr.gemHandle,WF_NEXTXYWH,box.X,box.Y,box.W,box.H)
  5580.                 end;
  5581.             ShowMouse;
  5582.             wind_update(END_UPDATE)
  5583.         end;
  5584.  
  5585.     begin
  5586.         if Class.ToolbarTree=nil then exit;
  5587.         if Attr.Status<>ws_Open then exit;
  5588.         if IsIconified then exit;
  5589.         pipe[0]:=GO_PRIVATE;
  5590.         pipe[1]:=Application^.apID;
  5591.         pipe[2]:=0;
  5592.         pipe[3]:=GOP_TOOLBAR;
  5593.         pipe[4]:=tbtree;
  5594.         pipe[5]:=Indx;
  5595.         pipe[6]:=KStat;
  5596.         pipe[7]:=Clicks;
  5597.         pe:=nil;
  5598.         p:=EventList;
  5599.         while p<>nil do
  5600.             if p^.TestMessage(pipe) then
  5601.                 begin
  5602.                     pe:=PToolbar(p);
  5603.                     break
  5604.                 end
  5605.             else
  5606.                 p:=p^.Next;
  5607.         if BStat=2 then
  5608.             begin
  5609.                 if pe<>nil then
  5610.                     if pe^.IsHelpAvailable then
  5611.                         begin
  5612.                             graf_mkstate(bx,by,dummy,dummy);
  5613.                             Application^.BubbleHelp(bx,by,bbldelay,pe^.GetHelp)
  5614.                         end;
  5615.                 exit
  5616.             end;
  5617.         if pe=nil then
  5618.             begin
  5619.                 oadr:=@Class.ToolbarTree^[Indx];
  5620.                 if oadr=nil then exit;
  5621.                 if not(bTst(oadr^.ob_flags,SELECTABLE)) or bTst(oadr^.ob_state,DISABLED) then exit
  5622.             end
  5623.         else
  5624.             begin
  5625.                 if pe^.GetState=bf_Disabled then exit;
  5626.                 oadr:=pe^.ObjAddr
  5627.             end;
  5628.         wind_update(BEG_UPDATE);
  5629.         wind_update(BEG_MCTRL);
  5630.         onbtn:=true;
  5631.         if pe<>nil then
  5632.             if pe^.IsSwitch then
  5633.                 begin
  5634.                     pe^.Toggle;
  5635.                     repeat
  5636.                         graf_mkstate(dummy,dummy,bs,dummy)
  5637.                     until bs=0;
  5638.                     goto _fertig
  5639.                 end;
  5640.         if pe<>nil then pe^.Check
  5641.         else
  5642.             CheckAndDraw(bf_Checked);
  5643.         objc_offset(Class.ToolbarTree,Indx,bx,by);
  5644.         with brect do
  5645.             begin
  5646.                 X:=bx;
  5647.                 Y:=by;
  5648.                 W:=oadr^.ob_width;
  5649.                 H:=oadr^.ob_height
  5650.             end;
  5651.         repeat
  5652.             graf_mkstate(bx,by,bs,dummy);
  5653.             inrect:=false;
  5654.             with mrect do wind_get(Attr.gemHandle,WF_FIRSTXYWH,X,Y,W,H);
  5655.             while (mrect.W>0) and (mrect.H>0) do
  5656.                 begin
  5657.                     if rc_intersect(DRect,mrect) then
  5658.                         if rc_intersect(brect,mrect) then
  5659.                             with mrect do
  5660.                                 if (bx>=X1) and (by>=Y1) and (bx<=X2) and (by<=Y2) then
  5661.                                     begin
  5662.                                         inrect:=true;
  5663.                                         break
  5664.                                     end;
  5665.                     with mrect do wind_get(Attr.gemHandle,WF_NEXTXYWH,X,Y,W,H)
  5666.                 end;
  5667.             if inrect<>onbtn then
  5668.                 begin
  5669.                     if pe<>nil then pe^.Toggle
  5670.                     else
  5671.                         if inrect then CheckAndDraw(bf_Checked)
  5672.                         else
  5673.                             CheckAndDraw(bf_Unchecked);
  5674.                     onbtn:=inrect
  5675.                 end;
  5676.         until bs=0;
  5677.         _fertig:
  5678.         wind_update(END_MCTRL);
  5679.         wind_update(END_UPDATE);
  5680.         if onbtn then
  5681.             begin
  5682.                 if pe<>nil then
  5683.                     with pe^ do
  5684.                         begin
  5685.                             Work;
  5686.                             if VPipe<>nil then
  5687.                                 begin
  5688.                                     if VGHnd then VPipe^[3]:=Attr.gemHandle;
  5689.                                     appl_write(Application^.apID,16,VPipe)
  5690.                                 end
  5691.                         end;
  5692.                 if hi(oadr^.ob_type)>ROOT then
  5693.                     begin
  5694.                         if bTst(Class.Style,cs_UserToolbar) then MNSelected(hi(oadr^.ob_type),0,nil,0)
  5695.                         else
  5696.                             Application^.MNSelected(hi(oadr^.ob_type),0,nil,0)
  5697.                     end;
  5698.                 if pe=nil then CheckAndDraw(bf_Unchecked)
  5699.                 else
  5700.                     if not(pe^.IsSwitch) then pe^.Uncheck
  5701.             end
  5702.     end;
  5703.  
  5704.  
  5705. function TWindow.WMKeyDown(Stat,Key: integer): boolean;
  5706.  
  5707.     begin
  5708.         WMKeyDown:=false
  5709.     end;
  5710.  
  5711.  
  5712. procedure TWindow.WMDragDrop(PipeHnd,OrgID,mX,mY,KStat: integer);
  5713.     label _readhdr,_prefext;
  5714.  
  5715.     var answer           : string;
  5716.         hdrlen,i         : integer;
  5717.         dtype            : string[4];
  5718.         dsize            : longint;
  5719.         dname,ndata,nfile: string[DD_NAMEMAX];
  5720.  
  5721.     begin
  5722.         answer:=chr(DD_OK);
  5723.         if fwrite(PipeHnd,1,@answer[1])<>1 then exit;
  5724.         _prefext:
  5725.         answer:=StrPLeft(DDGetPreferredTypes,DD_EXTSIZE);
  5726.         while length(answer)<DD_EXTSIZE do answer:=answer+#0;
  5727.         if fwrite(PipeHnd,DD_EXTSIZE,@answer[1])<>DD_EXTSIZE then exit;
  5728.         _readhdr:
  5729.         if fread(PipeHnd,2,@hdrlen)<>2 then exit;
  5730.         if hdrlen<9 then exit;
  5731.         dtype:='    ';
  5732.         if fread(PipeHnd,4,@dtype[1])<>4 then exit;
  5733.         if fread(PipeHnd,4,@dsize)<>4 then exit;
  5734.         dec(hdrlen,8);
  5735.         if hdrlen>DD_NAMEMAX then i:=DD_NAMEMAX
  5736.         else
  5737.             i:=hdrlen;
  5738.         fillchar(dname,sizeof(dname),0);
  5739.         if fread(PipeHnd,i,@dname[1])<>i then exit;
  5740.         dec(hdrlen,i);
  5741.         ndata:='';
  5742.         nfile:='';
  5743.         i:=1;
  5744.         while dname[i]<>#0 do
  5745.             begin
  5746.                 ndata:=ndata+dname[i];
  5747.                 inc(i)
  5748.             end;
  5749.         inc(i);
  5750.         while dname[i]<>#0 do
  5751.             begin
  5752.                 nfile:=nfile+dname[i];
  5753.                 inc(i)
  5754.             end;
  5755.         while hdrlen>DD_NAMEMAX+1 do
  5756.             begin
  5757.                 if fread(PipeHnd,DD_NAMEMAX+1,@dname)<>DD_NAMEMAX+1 then exit;
  5758.                 dec(hdrlen,DD_NAMEMAX+1)
  5759.             end;
  5760.         if hdrlen>0 then
  5761.             if fread(PipeHnd,hdrlen,@dname)<>hdrlen then exit;
  5762.         if dtype='PATH' then
  5763.             begin
  5764.                 answer:=StrPTrimF(DDGetPath);
  5765.                 if length(answer)=0 then answer:=chr(DD_NAK)
  5766.                 else
  5767.                     answer:=StrPLeft(chr(DD_OK)+answer,dsize);
  5768.                 fwrite(PipeHnd,length(answer),@answer[1]);
  5769.                 exit
  5770.             end;
  5771.         if dtype='ARGS' then
  5772.             begin
  5773.                 answer:=chr(DD_OK);
  5774.                 if fwrite(PipeHnd,1,@answer[1])<>1 then exit;
  5775.                 if dsize>0 then
  5776.                     if DDReadArgs(dsize,PipeHnd,OrgID,mX,mY,KStat) then Application^.ddokflag:=true;
  5777.                 exit
  5778.             end;
  5779.         answer:=chr(DDHeaderReply(dtype,ndata,nfile,dsize,OrgID,mX,mY,KStat));
  5780.         if fwrite(PipeHnd,1,@answer[1])<>1 then exit;
  5781.         case ord(answer[1]) of
  5782.             DD_OK:  if DDReadData(dtype,ndata,nfile,dsize,PipeHnd,OrgID,mX,mY,KStat) then Application^.ddokflag:=true;
  5783.             DD_EXT: goto _readhdr;
  5784.             DD_LEN: goto _prefext
  5785.         end
  5786.     end;
  5787.  
  5788.  
  5789. procedure TWindow.WMIconify(iX,iY,iW,iH: integer);
  5790.     var valid: boolean;
  5791.  
  5792.     begin
  5793.         if Attr.Status<>ws_Open then exit;
  5794.         form_dial(FMD_SHRINK,iX,iY,iW,iH,Curr.X,Curr.Y,Curr.W,Curr.H);
  5795.         if icfpos>=0 then
  5796.             begin
  5797.                 icfstyle:=Attr.Style;
  5798.                 SetGadgets(NAME+MOVER);
  5799.                 WMSized(iX,iY,iW,iH)
  5800.             end
  5801.         else
  5802.             begin
  5803.                 if Application^.pcrswatch=@self then
  5804.                     begin
  5805.                         DisableCrsWatch;
  5806.                         valid:=true
  5807.                     end
  5808.                 else
  5809.                     valid:=false;
  5810.                 wind_set(Attr.gemHandle,WF_ICONIFY,iX,iY,iW,iH);
  5811.                 if valid then EnableCrsWatch
  5812.             end;
  5813.         DisposeStr(icntitl);
  5814.         if icfpos>=0 then icntitl:=NewStr(StrPLeft(StrPTrimF(GetIconTitle),8)+#0)
  5815.         else
  5816.             icntitl:=NewStr(StrPLeft(StrPTrimF(GetIconTitle),10)+#0);
  5817.       if bTst(Attr.Style,NAME) then
  5818.             wind_set(Attr.gemHandle,WF_NAME,integer(HiWord(@icntitl^[1])),integer(LoWord(@icntitl^[1])),0,0);
  5819.         GetCurr;
  5820.         GetWork
  5821.     end;
  5822.  
  5823.  
  5824. procedure TWindow.WMUniconify(oX,oY,oW,oH: integer);
  5825.     var ICFFreePos: procedure(d1,d2: pointer; d3,d4,d5: longint; fn,posnr: integer);
  5826.         valid     : boolean;
  5827.  
  5828.     begin
  5829.         if Attr.Status<>ws_Open then exit;
  5830.         form_dial(FMD_GROW,Curr.X,Curr.Y,Curr.W,Curr.H,oX,oY,oW,oH);
  5831.         if icfpos>=0 then
  5832.             begin
  5833.                 ICFFreePos:=icfserver;
  5834.                 ICFFreePos(nil,nil,0,0,0,ICF_FREEPOS,icfpos);
  5835.                 icfpos:=-1;
  5836.                 SetGadgets(icfstyle);
  5837.                 WMSized(oX,oY,oW,oH)
  5838.             end
  5839.         else
  5840.             begin
  5841.                 if Application^.pcrswatch=@self then
  5842.                     begin
  5843.                         DisableCrsWatch;
  5844.                         valid:=true
  5845.                     end
  5846.                 else
  5847.                     valid:=false;
  5848.                 wind_set(Attr.gemHandle,WF_UNICONIFY,oX,oY,oW,oH);
  5849.                 if valid then EnableCrsWatch
  5850.             end;
  5851.       if bTst(Attr.Style,NAME) then
  5852.             wind_set(Attr.gemHandle,WF_NAME,integer(HiWord(@Attr.Title^[1])),integer(LoWord(@Attr.Title^[1])),0,0);
  5853.         DisposeStr(icntitl);
  5854.         GetCurr;
  5855.         GetWork
  5856.     end;
  5857.  
  5858.  
  5859. procedure TWindow.WMShaded;
  5860.  
  5861.     begin
  5862.     end;
  5863.  
  5864.  
  5865. procedure TWindow.WMUnshaded;
  5866.  
  5867.     begin
  5868.     end;
  5869.  
  5870.  
  5871. function TWindow.DDGetPreferredTypes: string;
  5872.  
  5873.     begin
  5874.         DDGetPreferredTypes:=Application^.DDGetPreferredTypes(Attr.gemHandle)
  5875.     end;
  5876.  
  5877.  
  5878. function TWindow.DDGetPath: string;
  5879.  
  5880.     begin
  5881.         DDGetPath:=''
  5882.     end;
  5883.  
  5884.  
  5885. function TWindow.DDHeaderReply(dType,dName,fName: string; dSize: longint; OrgID,mX,mY,KStat: integer): byte;
  5886.  
  5887.     begin
  5888.         DDHeaderReply:=DD_NAK
  5889.     end;
  5890.  
  5891.  
  5892. function TWindow.DDReadData(dType,dName,fName: string; dSize: longint; PipeHnd,OrgID,mX,mY,KStat: integer): boolean;
  5893.  
  5894.     begin
  5895.         DDReadData:=false
  5896.     end;
  5897.  
  5898.  
  5899. function TWindow.DDReadArgs(dSize: longint; PipeHnd,OrgID,mX,mY,KStat: integer): boolean;
  5900.     var buffer: array [0..127] of byte;
  5901.  
  5902.     begin
  5903.         DDReadArgs:=false;
  5904.         if dSize<=0 then exit;
  5905.         while dSize>128 do
  5906.             begin
  5907.                 if fread(PipeHnd,128,@buffer)<>128 then exit;
  5908.                 dec(dSize,128)
  5909.             end;
  5910.         fread(PipeHnd,dSize,@buffer)
  5911.     end;
  5912.  
  5913.  
  5914. procedure TWindow.DDFinished(OrgID,mX,mY,KStat: integer);
  5915.  
  5916.     begin
  5917.     end;
  5918.  
  5919.  
  5920. procedure TWindow.Cut;
  5921.  
  5922.     begin
  5923.         Application^.Cut
  5924.     end;
  5925.  
  5926.  
  5927. procedure TWindow.Copy;
  5928.  
  5929.     begin
  5930.         Application^.Copy
  5931.     end;
  5932.  
  5933.  
  5934. procedure TWindow.Paste;
  5935.  
  5936.     begin
  5937.         Application^.Paste
  5938.     end;
  5939.  
  5940.  
  5941. procedure TWindow.Delete;
  5942.  
  5943.     begin
  5944.         Application^.Delete
  5945.     end;
  5946.  
  5947.  
  5948. procedure TWindow.SelectAll;
  5949.  
  5950.     begin
  5951.         IconSelect(true,id_No)
  5952.     end;
  5953.  
  5954.  
  5955. procedure TWindow.Print;
  5956.  
  5957.     begin
  5958.     end;
  5959.  
  5960.  
  5961. function TWindow.Previous: PWindow;
  5962.  
  5963.     begin
  5964.         Previous:=Prev
  5965.     end;
  5966.  
  5967.  
  5968. function TWindow.Next: PWindow;
  5969.  
  5970.     begin
  5971.         Next:=Nxt
  5972.     end;
  5973.  
  5974.  
  5975. function TWindow.At(Index: integer): PWindow;
  5976.     var len: integer;
  5977.         p  : PWindow;
  5978.  
  5979.     begin
  5980.         len:=0;
  5981.         p:=ChildList;
  5982.         while p<>nil do
  5983.             begin
  5984.                 inc(len);
  5985.                 p:=p^.Nxt
  5986.             end;
  5987.         At:=nil;
  5988.         if (Index<0) or (len=0) then exit;
  5989.         Index:=Index mod len;
  5990.         p:=ChildList;
  5991.         if Index>0 then
  5992.             for len:=0 to Index-1 do p:=p^.Nxt;
  5993.         At:=p
  5994.     end;
  5995.  
  5996.  
  5997. function TWindow.IndexOf(Item: PWindow): integer;
  5998.     var count: integer;
  5999.         p    : PWindow;
  6000.  
  6001.     begin
  6002.         IndexOf:=-1;
  6003.         count:=0;
  6004.         p:=ChildList;
  6005.         while p<>nil do
  6006.             begin
  6007.                 if p=Item then
  6008.                     begin
  6009.                         IndexOf:=count;
  6010.                         exit
  6011.                     end;
  6012.                 inc(count);
  6013.                 p:=p^.Nxt
  6014.             end
  6015.     end;
  6016.  
  6017.  
  6018. function TWindow.FirstWndThat(Test: PIterationFunc): PWindow;
  6019.     var p,pc: PWindow;
  6020.         cl  : IterationFunc;
  6021.  
  6022.     begin
  6023.         FirstWndThat:=nil;
  6024.         p:=ChildList;
  6025.         cl:=IterationFunc(Test);
  6026.         while p<>nil do
  6027.             begin
  6028.                 if cl(p) then
  6029.                     begin
  6030.                         FirstWndThat:=p;
  6031.                         exit
  6032.                     end;
  6033.                 pc:=p^.FirstWndThat(Test);
  6034.                 if pc<>nil then
  6035.                     begin
  6036.                         FirstWndThat:=pc;
  6037.                         exit
  6038.                     end;
  6039.                 p:=p^.Nxt
  6040.             end;
  6041.     end;
  6042.  
  6043.  
  6044. procedure TWindow.ForEachWnd(Action: PIterationProc);
  6045.     var p : PWindow;
  6046.         cl: IterationProc;
  6047.  
  6048.     begin
  6049.         p:=ChildList;
  6050.         cl:=IterationProc(Action);
  6051.         while p<>nil do
  6052.             begin
  6053.                 cl(p);
  6054.                 p^.ForEachWnd(Action);
  6055.                 p:=p^.Nxt
  6056.             end
  6057.     end;
  6058.  
  6059.  
  6060. procedure TWindow.IconSelect(OnOff: boolean; OffExc: integer);
  6061.     var pe: PEvent;
  6062.         pw: PWindow;
  6063.  
  6064.     begin
  6065.         pe:=EventList;
  6066.         if OnOff then
  6067.             while pe<>nil do
  6068.                 begin
  6069.                     if bTst(pe^.Style,es_Icon) then PIcon(pe)^.Check;
  6070.                     pe:=pe^.Next
  6071.                 end
  6072.         else
  6073.             begin
  6074.                 if Attr.gemHandle<>OffExc then
  6075.                     while pe<>nil do
  6076.                         begin
  6077.                             if bTst(pe^.Style,es_Icon) then PIcon(pe)^.Uncheck;
  6078.                             pe:=pe^.Next
  6079.                         end;
  6080.                 pw:=ChildList;
  6081.                 while pw<>nil do
  6082.                     begin
  6083.                         pw^.IconSelect(false,OffExc);
  6084.                         pw:=pw^.Next
  6085.                     end
  6086.             end
  6087.     end;
  6088.  
  6089.  
  6090. function TWindow.FirstIcon(OnAll: boolean): PIcon;
  6091.  
  6092.     begin
  6093.         icnonall:=OnAll;
  6094.         nxticn:=EventList;
  6095.         FirstIcon:=NextIcon
  6096.     end;
  6097.  
  6098.  
  6099. function TWindow.NextIcon: PIcon;
  6100.     label _weiter;
  6101.  
  6102.     begin
  6103.         NextIcon:=nil;
  6104.         while nxticn<>nil do
  6105.             begin
  6106.                 if bTst(nxticn^.Style,es_Icon) then
  6107.                     begin
  6108.                         if icnonall then
  6109.                             if PIcon(nxticn)^.GetCheck<>bf_Checked then goto _weiter;
  6110.                         NextIcon:=PIcon(nxticn);
  6111.                         nxticn:=nxticn^.Next;
  6112.                         exit
  6113.                     end;
  6114.                 _weiter:
  6115.                 nxticn:=nxticn^.Next
  6116.             end
  6117.     end;
  6118.  
  6119.  
  6120. function TWindow.FirstWorkRect(var Rect: GRECT): boolean;
  6121.  
  6122.     begin
  6123.         if IsModeless then
  6124.             if Attr.Status=ws_Open then
  6125.                 begin
  6126.                     GetWork;
  6127.                     with Rect do wind_get(Attr.gemHandle,WF_FIRSTXYWH,X,Y,W,H);
  6128.                     while (Rect.W>0) and (Rect.H>0) do
  6129.                         begin
  6130.                             if rc_intersect(DRect,Rect) then
  6131.                                 if rc_intersect(Work,Rect) then
  6132.                                     begin
  6133.                                         FirstWorkRect:=true;
  6134.                                         exit
  6135.                                     end;
  6136.                             with Rect do wind_get(Attr.gemHandle,WF_NEXTXYWH,X,Y,W,H)
  6137.                         end
  6138.                 end;
  6139.         FirstWorkRect:=false;
  6140.         Rect.W:=0
  6141.     end;
  6142.  
  6143.  
  6144. function TWindow.NextWorkRect(var Rect: GRECT): boolean;
  6145.  
  6146.     begin
  6147.         if IsModeless then
  6148.             if Attr.Status=ws_Open then
  6149.                 begin
  6150.                     with Rect do wind_get(Attr.gemHandle,WF_NEXTXYWH,X,Y,W,H);
  6151.                     while (Rect.W>0) and (Rect.H>0) do
  6152.                         begin
  6153.                             if rc_intersect(DRect,Rect) then
  6154.                                 if rc_intersect(Work,Rect) then
  6155.                                     begin
  6156.                                         NextWorkRect:=true;
  6157.                                         exit
  6158.                                     end;
  6159.                             with Rect do wind_get(Attr.gemHandle,WF_NEXTXYWH,X,Y,W,H)
  6160.                         end
  6161.                 end;
  6162.         NextWorkRect:=false;
  6163.         Rect.W:=0
  6164.     end;
  6165.  
  6166.  
  6167.     { private }
  6168.  
  6169.  
  6170. procedure TWindow.EnableCrsWatch;
  6171.     var cursor: HCursor;
  6172.  
  6173.     begin
  6174.         if Application^.pcrswatch<>@self then
  6175.             begin
  6176.                 if Application^.pcrswatch<>nil then
  6177.                     with Application^ do
  6178.                         begin
  6179.                             pcrswatch:=nil;
  6180.                             Attr.EventMask:=Attr.EventMask and not(MU_M1 or MU_M2);
  6181.                             if not(IsMouseBusy) then graf_mouse(wmnr,@wmform)
  6182.                         end;
  6183.                 if IsIconified then cursor:=IconClass.hCursor
  6184.                 else
  6185.                     cursor:=Class.hCursor;
  6186.                 if cursor>id_No then
  6187.                     begin
  6188.                         Application^.pcrswatch:=@self;
  6189.                         Application^.Attr.EventMask:=Application^.Attr.EventMask or MU_M1
  6190.                     end
  6191.             end
  6192.     end;
  6193.  
  6194.  
  6195. procedure TWindow.DisableCrsWatch;
  6196.     var p: PWindow;
  6197.  
  6198.     begin
  6199.         if Application^.pcrswatch=@self then
  6200.             begin
  6201.                 with Application^ do
  6202.                     begin
  6203.                         pcrswatch:=nil;
  6204.                         Attr.EventMask:=Attr.EventMask and not(MU_M1 or MU_M2);
  6205.                         if not(IsMouseBusy) then graf_mouse(wmnr,@wmform);
  6206.                         p:=GetPTopWindow
  6207.                     end;
  6208.                 if (p<>nil) and (p<>@self) then p^.EnableCrsWatch
  6209.             end
  6210.     end;
  6211.  
  6212.  
  6213. procedure TWindow.Iconify(fade: boolean);
  6214.  
  6215.     begin
  6216.         if fade then
  6217.             begin
  6218.                 icnx:=Curr.X;
  6219.                 WMMoved(DRect.X+DRect.W+20,Curr.Y,Curr.W,Curr.H)
  6220.             end
  6221.         else
  6222.             WMMoved(icnx,Curr.Y,Curr.W,Curr.H)
  6223.     end;
  6224.  
  6225.  
  6226. function TWindow.CycleTop(start: PWindow; backwrd: boolean): boolean;
  6227.     var p: PWindow;
  6228.  
  6229.     begin
  6230.         if IsModeless and (Attr.Status=ws_Open) and (start<>@self) then
  6231.             begin
  6232.                 Top;
  6233.                 CycleTop:=true;
  6234.                 exit
  6235.             end;
  6236.         CycleTop:=false;
  6237.         p:=ChildList;
  6238.         if backwrd then
  6239.             begin
  6240.                 while p<>nil do
  6241.                     begin
  6242.                         if p^.Next=nil then break;
  6243.                         p:=p^.Next
  6244.                     end;
  6245.                 while p<>nil do
  6246.                     begin
  6247.                         if p^.CycleTop(start,true) then
  6248.                             begin
  6249.                                 CycleTop:=true;
  6250.                                 exit
  6251.                             end;
  6252.                         p:=p^.Previous
  6253.                     end
  6254.             end
  6255.         else
  6256.             while p<>nil do
  6257.                 begin
  6258.                     if p^.CycleTop(start,false) then
  6259.                         begin
  6260.                             CycleTop:=true;
  6261.                             exit
  6262.                         end;
  6263.                     p:=p^.Next
  6264.                 end
  6265.     end;
  6266.  
  6267. { *** TWINDOW *** }
  6268.  
  6269.  
  6270.  
  6271. { *** Objekt TAPPLICATION *** }
  6272.  
  6273. constructor TApplication.Init(AnID: TCookieID; AName: string);
  6274.     const fontset: AESOBJECT = (ob_next:-1;ob_head:-1;ob_tail:-1;ob_type:G_STRING;
  6275.                                   ob_flags:LASTOB;ob_state:NORMAL;ob_spec:(free_string:PChar(' '));
  6276.                                   ob_x:10;ob_y:10;ob_width:1;ob_height:1);
  6277.  
  6278.   var gval   : longint;
  6279.           dummy,
  6280.           fontid,
  6281.           extrsc : integer;
  6282.           fdst   : ARRAY_5;
  6283.           ffx    : ARRAY_3;
  6284.           atrb   : ARRAY_10;
  6285.           scmd   : string;
  6286.           pipe   : Pipearray;
  6287.           meta   : METAINFO;
  6288.           xdsc,
  6289.           has_agi: boolean;
  6290.           dst    : PChar;
  6291.  
  6292.     function appl_xgetinfo(ap_gtype: integer; var ap_gout1,ap_gout2,ap_gout3,ap_gout4: integer): boolean;
  6293.  
  6294.         begin
  6295.             appl_xgetinfo:=false;
  6296.             if has_agi then
  6297.                 with AES_pb do
  6298.                     begin
  6299.                         control^[0]:=130;
  6300.                         control^[1]:=1;
  6301.                         control^[2]:=5;
  6302.                         control^[3]:=0;
  6303.                         control^[4]:=0;
  6304.                         intin^[0]:=ap_gtype;
  6305.                         _crystal(@AES_pb);
  6306.                         if intout^[0]=1 then
  6307.                             begin
  6308.                                 ap_gout1:=intout^[1];
  6309.                                 ap_gout2:=intout^[2];
  6310.                                 ap_gout3:=intout^[3];
  6311.                                 ap_gout4:=intout^[4];
  6312.                                 appl_xgetinfo:=true
  6313.                             end
  6314.                     end
  6315.         end;
  6316.  
  6317.     function objc_xsysvar(what,ver: integer): integer;
  6318.         var objsvar  : boolean;
  6319.             dummy,osv: integer;
  6320.  
  6321.         begin
  6322.             objc_xsysvar:=White;
  6323.             if not(bTst(Attr.Style,as_3DFlags)) then exit;
  6324.             if appl_xgetinfo(13,dummy,osv,dummy,dummy) then objsvar:=(osv>0)
  6325.             else
  6326.                 objsvar:=(GEMVersion>=$0400);
  6327.             if objsvar then
  6328.                 begin
  6329.                     with AES_pb do
  6330.                         begin
  6331.                             control^[0]:=48;
  6332.                             control^[1]:=4;
  6333.                             control^[2]:=3;
  6334.                             control^[3]:=0;
  6335.                             control^[4]:=0;
  6336.                             intin^[0]:=0;
  6337.                             intin^[1]:=what;
  6338.                             intin^[2]:=0;
  6339.                             intin^[3]:=0
  6340.                         end;
  6341.                     _crystal(@AES_pb);
  6342.                     if AES_pb.intout^[0]>0 then objc_xsysvar:=AES_pb.intout^[1]
  6343.                     else
  6344.                         if Attr.Colors>=LWhite then objc_xsysvar:=LWhite
  6345.                 end
  6346.             else
  6347.                 if (TOSVersion>=ver) and (Attr.Colors>=LWhite) then objc_xsysvar:=LWhite
  6348.         end;
  6349.  
  6350.   begin
  6351.     if not(inherited Init) then fail;
  6352.     termflag:=false;
  6353.     appdone:=true;
  6354.     Application:=@self;
  6355.     if AppFlag then Fsetdta(@apDTA);
  6356.     apName:=nil;
  6357.     apPath:=nil;
  6358.     pquit:=nil;
  6359.     xaccname:=nil;
  6360.     XAccList:=nil;
  6361.     icnwnd:=nil;
  6362.     allicn:=false;
  6363.     nxticn:=nil;
  6364.     ID:=AnID;
  6365.     Name:=NewStr(AName);
  6366.     Status:=em_OK;
  6367.     Err:=em_OK;
  6368.     cliplock:=false;
  6369.     FirstInstance:=false;
  6370.     MainWindow:=nil;
  6371.     RscPtr:=nil;
  6372.     nappgen:=nil;
  6373.     MenuTree:=nil;
  6374.     MessageBuffer:=nil;
  6375.     MessageBLen:=0;
  6376.     pcrswatch:=nil;
  6377.     icfserver:=nil;
  6378.     menuentries:=nil;
  6379.     Clipboard:=nil;
  6380.     Icon:=nil;
  6381.     menuID:=-1;
  6382.     apID:=-1;
  6383.     vdiHandle:=-1;
  6384.     aesHandle:=-1;
  6385.     AVServer:=id_No;
  6386.     HMax:=-1;
  6387.     ticn:=-1;
  6388.     spderr:=0;
  6389.     deskinst:=false;
  6390.     GDOSActive:=false;
  6391.     MultiTOS:=false;
  6392.     IsQSBUsed:=false;
  6393.     DlgTop:=-1;
  6394.         with Attr do
  6395.             begin
  6396.                 Instance:=$42;
  6397.                 if GetCookie('_AKP',gval) then Country:=gval and $ff
  6398.                 else
  6399.                     Country:=PWord(longint(GetOSHeaderPtr)+28)^ shr 1;
  6400.                 rpCmd:=nil;
  6401.                 rpTail:=nil;
  6402.                 PopChar:=#2
  6403.             end;
  6404.         FPUAvailable:=(Test68881<>0);
  6405.         if not(FPUAvailable) then
  6406.             if GetCookie('_FPU',gval) then
  6407.                 FPUAvailable:=((gval and $ffff)<>0) or ((gval and $ffff0000)>$00010000);
  6408.         OSBAvailable:=GetCookie('EdDI',gval);
  6409.         if GetCookie('FSMC',gval) then SpeedoActive:=(PLongint(gval)^=1599295556)
  6410.         else
  6411.             SpeedoActive:=false;
  6412.         if not(GetCookie('HELP',gval)) then
  6413.             begin
  6414.                 NewCookie('HELP',$01f4ffff);
  6415.                 bbldelay:=500
  6416.             end
  6417.         else
  6418.             bbldelay:=(gval shr 16) and $ffff;
  6419.         if GetCookie('LTMF',gval) then ltmf:=PLTMFLY(gval)
  6420.         else
  6421.             ltmf:=nil;
  6422.         MiNTActive:=(MiNTVersion>0);
  6423.         fillchar(meta,sizeof(meta),0);
  6424.         metainit(meta);
  6425.         if meta.version=nil then MetaDOS:=nil
  6426.         else
  6427.             begin
  6428.                 new(MetaDOS);
  6429.                 MetaDOS^.Drives:=meta.drivemap;
  6430.                 MetaDOS^.Version:=StrPas(meta.version)
  6431.             end;
  6432.     InitGem;
  6433.     if Status>=em_OK then
  6434.         begin
  6435.             wind_update(BEG_UPDATE);
  6436.             GetDesk(DRect);
  6437.             scmd:='';
  6438.           with Attr do
  6439.               begin
  6440.                   MaxPX:=workOut[0];
  6441.                   MaxPY:=workOut[1];
  6442.                   PixW:=workOut[3];
  6443.                   PixH:=workOut[4];
  6444.                   Colors:=workOut[13];
  6445.                   MaxColors:=workOut[39];
  6446.                   sysFonts:=workOut[10];
  6447.                   addFonts:=0;
  6448.                   Planes:=GEM_pb.global[10];
  6449.                         EventMask:=MU_MESAG or MU_KEYBD or MU_BUTTON;
  6450.                         if MultiTOS then
  6451.                             begin
  6452.                                 EventMask:=EventMask or MU_TIMER;
  6453.                                 poptimer:=300
  6454.                             end
  6455.                         else
  6456.                             poptimer:=1;
  6457.                   Style:=as_GrowShrink or as_MenuSeparator or as_MoveDials or as_HandleShutdown or as_3DFlags or as_UseHomeDir;
  6458.                   if not(AppFlag) then Style:=Style or as_DesktopWindow;
  6459.                         if rpCmd<>nil then
  6460.                             begin
  6461.                                 scmd:=StrPRight(rpCmd^,length(rpCmd^)-RPos('\',rpCmd^));
  6462.                                 if pos('.',scmd)>0 then scmd:=StrPLeft(scmd,pos('.',scmd)-1);
  6463.                                 scmd:=StrPLeft(scmd,8);
  6464.                                 apPath:=NewStr(StrPLeft(rpCmd^,RPos('\',rpCmd^)))
  6465.                             end
  6466.                     end;
  6467.                 if SpeedoActive then vst_error(vdiHandle,0,spderr);
  6468.                 apName:=NewStr(scmd+StrPSpace(8-length(scmd))+#0);
  6469.                 GDOSActive:=(vq_gdos<>0);
  6470.                 has_agi:=(GEMVersion>=$0400);
  6471.                 if not(has_agi) then has_agi:=(wind_get(0,WF_WINX,dummy,dummy,dummy,dummy)=WF_WINX);
  6472.                 if not(has_agi) then
  6473.                     if GetCookie('MagX',gval) then
  6474.                         if gval<>0 then
  6475.                             with PMAGX_COOKIE(gval)^ do
  6476.                                 if aes_vars<>nil then
  6477.                                     with aes_vars^ do
  6478.                                         has_agi:=(magic=-2023406815) and (magic2='MAGX') and (version>=$0200);
  6479.                 if not(has_agi) then has_agi:=(appl_find('?AGI')=0);
  6480.                 if appl_xgetinfo(0,SysInfo.SFHeight,fontid,dummy,dummy) then
  6481.                     begin
  6482.                         gem.vst_font(vdiHandle,fontid);
  6483.                         gem.vst_height(vdiHandle,SysInfo.SFHeight,dummy,dummy,dummy,dummy);
  6484.                         vqt_attributes(aesHandle,atrb);
  6485.                         SysInfo.SFWidth:=atrb[8]
  6486.                     end
  6487.                 else
  6488.                     begin
  6489.                         objc_draw(@fontset,ROOT,0,0,0,1,1);
  6490.                         vqt_attributes(aesHandle,atrb);
  6491.                         SysInfo.SFHeight:=atrb[7];
  6492.                         SysInfo.SFWidth:=atrb[8];
  6493.                         if SysInfo.SFHeight<6 then
  6494.                             begin
  6495.                                 if (Attr.MaxPX<639) or (Attr.MaxPY<399) then gem.vst_point(vdiHandle,9,dummy,dummy,dummy,dummy)
  6496.                                 else
  6497.                                     gem.vst_point(vdiHandle,10,dummy,dummy,dummy,dummy);
  6498.                                 vqt_fontinfo(vdiHandle,dummy,dummy,fdst,SysInfo.SFWidth,ffx);
  6499.                                 SysInfo.SFHeight:=fdst[4]
  6500.                             end
  6501.                     end;
  6502.                 if appl_xgetinfo(2,dummy,dummy,fontid,extrsc) then
  6503.                     begin
  6504.                         agi.ColorIcons:=(fontid=1);
  6505.                         agi.ExtRsc:=(extrsc=1)
  6506.                     end
  6507.                 else
  6508.                     begin
  6509.                         agi.ColorIcons:=(GEMVersion>=$0330) and (GEMVersion<>MAGIX);
  6510.                         agi.ExtRsc:=agi.ColorIcons
  6511.                     end;
  6512.                 if appl_xgetinfo(10,fontid,dummy,dummy,dummy) then
  6513.                     begin
  6514.                         agi.Shutdown:=((fontid and $00ff)>=9);
  6515.                         agi.Broadcast:=((fontid and $00ff)>=7)
  6516.                     end
  6517.                 else
  6518.                     begin
  6519.                         agi.Shutdown:=(GEMVersion>=$0400);
  6520.                         agi.Broadcast:=agi.Shutdown
  6521.                     end;
  6522.                 if appl_xgetinfo(11,extrsc,dummy,agi.Gadgets,fontid) then
  6523.                     begin
  6524.                         agi.WindUpdate:=(fontid=1);
  6525.                         agi.Owner:=bTst(extrsc,16);
  6526.                         agi.BEvent:=bTst(extrsc,32);
  6527.                         agi.Backdrop:=bTst(extrsc,64);
  6528.                         agi.Iconify:=bTst(extrsc,384) and bTst(agi.Gadgets,1)
  6529.                     end
  6530.                 else
  6531.                     begin
  6532.                         agi.WindUpdate:=(GEMVersion>=$0400);
  6533.                         agi.Iconify:=(GEMVersion>=$0410);
  6534.                         agi.BEvent:=agi.WindUpdate;
  6535.                         agi.Backdrop:=agi.WindUpdate;
  6536.                         agi.Owner:=agi.WindUpdate;
  6537.                         if GEMVersion>=$0410 then agi.Gadgets:=1
  6538.                         else
  6539.                             agi.Gadgets:=0
  6540.                     end;
  6541.                 if appl_xgetinfo(4,dummy,dummy,fontid,dummy) then agi.ApplSearch:=(fontid=1)
  6542.                 else
  6543.                     agi.ApplSearch:=(GEMVersion>=$0400);
  6544.                 if appl_xgetinfo(9,dummy,dummy,dummy,fontid) then agi.ExtMnSelect:=(fontid=1)
  6545.                 else
  6546.                     agi.ExtMnSelect:=(GEMVersion>=$0330) and (GEMVersion<>MAGIX);
  6547.                 if appl_xgetinfo(6,dummy,dummy,fontid,dummy) then agi.MenuInq:=(fontid=1)
  6548.                 else
  6549.                     agi.MenuInq:=MultiTOS;
  6550.                 if appl_xgetinfo(3,fontid,dummy,dummy,dummy) then Attr.Country:=fontid;
  6551.             agi.MultiProto:=(GEM_pb.global[1]<>1) and (agi.ApplSearch or agi.Broadcast);
  6552.                 SysInfo.BGDefCol:=objc_xsysvar(BACKGRCOL,$0404);
  6553.                 bfalcol:=objc_xsysvar(ACTBUTCOL,$0100);
  6554.                 if GetCookie('ICFS',gval) and not(agi.Iconify) then icfserver:=pointer(gval);
  6555.                 Clipboard:=GetClipboard;
  6556.           SetupVDI;
  6557.                 if Status>=em_OK then
  6558.                     begin
  6559.                         SysInfo.BGDefCol:=objc_xsysvar(BACKGRCOL,$0404);
  6560.                         bfalcol:=objc_xsysvar(ACTBUTCOL,$0100);
  6561.                         gval:=0;
  6562.                         GetXAccAttr(XAcc);
  6563.                         with XAcc do
  6564.                             begin
  6565.                                 if AppTypeHR=nil then AppTypeHR:=NewStr(XAccMR2HR(AppTypeMR));
  6566.                                 if length(AppTypeMR)>0 then inc(gval,length(AppTypeMR)+2);
  6567.                                 if AppTypeHR<>nil then inc(gval,length(AppTypeHR^)+2);
  6568.                                 if ExtFeatures<>nil then inc(gval,length(ExtFeatures^)+2);
  6569.                                 if GenericName<>nil then inc(gval,length(GenericName^)+2)
  6570.                             end;
  6571.                         if gval>0 then inc(gval,5);
  6572.                         xdsc:=(gval>0);
  6573.                         inc(gval,length(Name^)+2);
  6574.                         if MiNTActive then xaccname:=mxalloc(gval,GLOBAL)
  6575.                         else
  6576.                             getmem(xaccname,gval);
  6577.                         if xaccname<>nil then
  6578.                             begin
  6579.                                 if xdsc then
  6580.                                     begin
  6581.                                         StrPCopy(xaccname,Name^+#0'XDSC');
  6582.                                         dst:=PChar(longint(xaccname)+length(Name^)+6);
  6583.                                         with XAcc do
  6584.                                             begin
  6585.                                                 pXDSC:=dst;
  6586.                                                 if AppTypeHR<>nil then
  6587.                                                     begin
  6588.                                                         StrPCopy(dst,'1'+AppTypeHR^);
  6589.                                                         dst:=PChar(longint(dst)+length(AppTypeHR^)+2)
  6590.                                                     end;
  6591.                                                 if length(AppTypeMR)>0 then
  6592.                                                     begin
  6593.                                                         StrPCopy(dst,'2'+AppTypeMR);
  6594.                                                         dst:=PChar(longint(dst)+length(AppTypeMR)+2)
  6595.                                                     end;
  6596.                                                 if ExtFeatures<>nil then
  6597.                                                     begin
  6598.                                                         StrPCopy(dst,'X'+ExtFeatures^);
  6599.                                                         dst:=PChar(longint(dst)+length(ExtFeatures^)+2)
  6600.                                                     end;
  6601.                                                 if GenericName<>nil then
  6602.                                                     begin
  6603.                                                         StrPCopy(dst,'N'+GenericName^);
  6604.                                                         dst:=PChar(longint(dst)+length(GenericName^)+2)
  6605.                                                     end
  6606.                                             end;
  6607.                                         dst^:=#0
  6608.                                     end
  6609.                                 else
  6610.                                     StrPCopy(xaccname,Name^+#0)
  6611.                             end;
  6612.                 if not(GetCookie(ID,gval)) then InitApplication
  6613.                 else
  6614.                   begin
  6615.                       if (gval and $ffffff00)=getcval then
  6616.                           begin
  6617.                               Attr.Instance:=(gval and $ff)+1;
  6618.                                     ChangeCookie(ID,getcval+Attr.Instance)
  6619.                           end
  6620.                       else
  6621.                           begin
  6622.                               Attr.Instance:=0;
  6623.                               InitApplication
  6624.                           end
  6625.                   end;
  6626.                 if Status>=em_OK then InitInstance;
  6627.                         if agi.MultiProto then
  6628.                             if Status>=em_OK then
  6629.                             begin
  6630.                                     pipe[0]:=ACC_ID;
  6631.                                     pipe[3]:=integer((XAcc.Version shl 8)+XAcc.MsgGroups);
  6632.                                     pipe[4]:=integer(HiWord(xaccname));
  6633.                                     pipe[5]:=integer(LoWord(xaccname));
  6634.                                     pipe[6]:=menuID;
  6635.                                     pipe[7]:=0;
  6636.                                     Broadcast(@pipe,true);
  6637.                                     dummy:=appl_find('GEMINI  ');
  6638.                                     if dummy<0 then dummy:=appl_find('AVSERVER');
  6639.                                     if dummy<0 then
  6640.                                         begin
  6641.                                             scmd:=GetEnv('AVSERVER');
  6642.                                             if length(scmd)>0 then
  6643.                                                 begin
  6644.                                                     scmd:=StrPLeft(StrPTrimF(scmd),8);
  6645.                                                     dummy:=appl_find(scmd+StrPSpace(8-length(scmd)))
  6646.                                                 end
  6647.                                         end;
  6648.                                     if dummy>=0 then
  6649.                                         begin
  6650.                                             pipe[0]:=AV_PROTOKOLL;
  6651.                                             pipe[1]:=apID;
  6652.                                             pipe[2]:=0;
  6653.                                             pipe[3]:=integer(XAcc.AVAccMsg);
  6654.                                             pipe[4]:=0;
  6655.                                             pipe[5]:=0;
  6656.                                             pipe[6]:=integer((longint(apName)+1) div 65536);
  6657.                                             pipe[7]:=integer((longint(apName)+1) mod 65536);
  6658.                                             appl_write(dummy,16,@pipe)
  6659.                                         end
  6660.                                 end
  6661.                     end;
  6662.                 wind_update(END_UPDATE)
  6663.       end
  6664.   end;
  6665.  
  6666.  
  6667. destructor TApplication.Done;
  6668.     var ci  : integer;
  6669.  
  6670.     begin
  6671.         appdone:=false;
  6672.         while (MainWindow<>nil) do MainWindow^.Free;
  6673.         if termflag then Terminate;
  6674.         ClosePrivateProfile;
  6675.         if Attr.Instance>0 then
  6676.             begin
  6677.                 ci:=GetCurrInstance;
  6678.                 if ci>=2 then ChangeCookie(ID,getcval+ci-1)
  6679.                 else
  6680.                     RemoveCookie(ID)
  6681.             end;
  6682.         if XAccList<>nil then
  6683.             begin
  6684.                 XAccList^.ForEach(@SendXAccExit);
  6685.                 dispose(PXAccCollection(XAccList),Done);
  6686.                 XAccList:=nil
  6687.             end;
  6688.         if not(AppFlag or MultiTOS) then while true do evnt_timer(0,1);
  6689.         if Clipboard<>nil then dispose(Clipboard,Done);
  6690.         ExitGem;
  6691.         Application:=nil;
  6692.         DisposeStr(Attr.rpTail);
  6693.         DisposeStr(Attr.rpCmd);
  6694.         DisposeStr(XAcc.AppTypeHR);
  6695.         DisposeStr(XAcc.ExtFeatures);
  6696.         DisposeStr(XAcc.GenericName);
  6697.         DisposeStr(apName);
  6698.         DisposeStr(apPath);
  6699.     DisposeStr(Name);
  6700.         if xaccname<>nil then mfree(xaccname);
  6701.     inherited Done
  6702.   end;
  6703.  
  6704.  
  6705. function TApplication.CanClose: boolean;
  6706.     var p    : PWindow;
  6707.         valid: boolean;
  6708.  
  6709.     begin
  6710.         if (AppFlag or MultiTOS) then
  6711.           begin
  6712.               p:=MainWindow;
  6713.               valid:=true;
  6714.               while (p<>nil) and valid do
  6715.                   with p^ do
  6716.                       begin
  6717.                           if Attr.Status=ws_Open then
  6718.                               if not(CanClose) then valid:=false;
  6719.                           p:=Nxt
  6720.                       end;
  6721.               CanClose:=valid
  6722.           end
  6723.         else
  6724.             CanClose:=false
  6725.     end;
  6726.  
  6727.  
  6728. function TApplication.IsIconified: boolean;
  6729.  
  6730.     begin
  6731.         IsIconified:=allicn
  6732.     end;
  6733.  
  6734.  
  6735. procedure TApplication.LoadResource(FileHiRes,FileLoRes: string);
  6736.     var vald: boolean;
  6737.  
  6738.     begin
  6739.         if RscPtr=nil then
  6740.             begin
  6741.                 if Attr.MaxPY>=399 then
  6742.                     begin
  6743.                         if rsrc_load(FileHiRes)=0 then vald:=(rsrc_load(FileLoRes)<>0)
  6744.                         else
  6745.                             vald:=true
  6746.                     end
  6747.                 else
  6748.                     begin
  6749.                         if rsrc_load(FileLoRes)=0 then vald:=(rsrc_load(FileHiRes)<>0)
  6750.                         else
  6751.                             vald:=true
  6752.                     end;
  6753.                 if vald then
  6754.                     begin
  6755.                         RscPtr:=RSC_LOADED;
  6756.                         FixResource(Ptr(word(GEM_pb.global[7]),word(GEM_pb.global[8])),FIXRSC,FIX_BBONLY)
  6757.                     end
  6758.                 else
  6759.                     begin
  6760.                         RscPtr:=nil;
  6761.                         Status:=em_RscNotFound;
  6762.                         Err:=Status;
  6763.                         Error(Err)
  6764.                     end
  6765.             end
  6766.     end;
  6767.  
  6768.  
  6769. procedure TApplication.InitResource(AddrHiRes,AddrLoRes: pointer);
  6770.     var pool: AESTreePtrArrayPtr;
  6771.  
  6772.     begin
  6773.         if (RscPtr=nil) and ((AddrHiRes<>nil) or (AddrLoRes<>nil)) then
  6774.             begin
  6775.               if AddrHiRes=nil then AddrHiRes:=AddrLoRes;
  6776.               if AddrLoRes=nil then AddrLoRes:=AddrHiRes;
  6777.               if Attr.MaxPY>=399 then RscPtr:=AddrHiRes
  6778.               else
  6779.                 RscPtr:=AddrLoRes;
  6780.                 FixResource(RscPtr,FIXRSC,FIX_ALL);
  6781.                 pool:=@RscPtr^.rsd[RscPtr^.rsh.rsh_trindex];
  6782.                 with GEM_pb do
  6783.                     begin
  6784.                         global[5]:=integer(HiWord(pool));
  6785.                         global[6]:=integer(LoWord(pool));
  6786.                         global[7]:=integer(HiWord(RscPtr));
  6787.                         global[8]:=integer(LoWord(RscPtr));
  6788.                         global[9]:=integer(RscPtr^.rsh.rsh_rssize)
  6789.                     end
  6790.             end
  6791.     end;
  6792.  
  6793.  
  6794. function TApplication.GetAddr(Indx: integer): PTree;
  6795.     var tree: pointer;
  6796.  
  6797.     begin
  6798.         if RscPtr<>nil then
  6799.             begin
  6800.                 if RscPtr=RSC_LOADED then
  6801.                     begin
  6802.                         if rsrc_gaddr(R_TREE,Indx,tree)<>0 then
  6803.                             GetAddr:=tree
  6804.                         else
  6805.                             GetAddr:=nil
  6806.                     end
  6807.                 else
  6808.                     GetAddr:=AESTreePtrArrayPtr(@RscPtr^.rsd[RscPtr^.rsh.rsh_trindex])^[Indx]
  6809.             end
  6810.         else
  6811.             GetAddr:=nil
  6812.     end;
  6813.  
  6814.  
  6815. function TApplication.GetFImagePtr(Indx: integer): pointer;
  6816.     var imgptr: pointer;
  6817.  
  6818.     begin
  6819.         if RscPtr<>nil then
  6820.             begin
  6821.                 if RscPtr=RSC_LOADED then
  6822.                     begin
  6823.                         if rsrc_gaddr(R_FRIMG,ROOT,imgptr)=0 then GetFImagePtr:=nil
  6824.                         else
  6825.                             GetFImagePtr:=FreeImgPtrArrayPtr(imgptr)^[Indx]
  6826.                     end
  6827.                 else
  6828.                     begin
  6829.                         if (Indx>=0) and (Indx<RscPtr^.rsh.rsh_nimages) then
  6830.                             GetFImagePtr:=FreeImgPtrArrayPtr(@RscPtr^.rsd[RscPtr^.rsh.rsh_frimg])^[Indx]
  6831.                         else
  6832.                             GetFImagePtr:=nil
  6833.                     end
  6834.             end
  6835.         else
  6836.             GetFImagePtr:=nil
  6837.     end;
  6838.  
  6839.  
  6840. function TApplication.GetFStringPtr(Indx: integer): PChar;
  6841.     var strptr: pointer;
  6842.  
  6843.     begin
  6844.         if RscPtr<>nil then
  6845.             begin
  6846.                 if RscPtr=RSC_LOADED then
  6847.                     begin
  6848.                         if rsrc_gaddr(R_FRSTR,ROOT,strptr)=0 then GetFStringPtr:=nil
  6849.                         else
  6850.                             GetFStringPtr:=FreeStrPtrArrayPtr(strptr)^[Indx]
  6851.                     end
  6852.                 else
  6853.                     begin
  6854.                         if (Indx>=0) and (Indx<RscPtr^.rsh.rsh_nstring) then
  6855.                             GetFStringPtr:=FreeStrPtrArrayPtr(@RscPtr^.rsd[RscPtr^.rsh.rsh_frstr])^[Indx]
  6856.                         else
  6857.                             GetFStringPtr:=nil
  6858.                     end
  6859.             end
  6860.         else
  6861.             GetFStringPtr:=nil
  6862.     end;
  6863.  
  6864.  
  6865. function TApplication.GetFString(Indx: integer): string;
  6866.  
  6867.     begin
  6868.         GetFString:=StrPas(GetFStringPtr(Indx))
  6869.     end;
  6870.  
  6871.  
  6872. function TApplication.GetIconTitle: string;
  6873.  
  6874.     begin
  6875.         GetIconTitle:=Name^
  6876.     end;
  6877.  
  6878.  
  6879. function TApplication.GetClipboard: PClipboard;
  6880.  
  6881.     begin
  6882.         GetClipboard:=new(PClipboard,Init(@self))
  6883.     end;
  6884.  
  6885.  
  6886. procedure TApplication.GetXAccAttr(var XAccAttr: TXAccAttr);
  6887.  
  6888.     begin
  6889.         with XAccAttr do
  6890.             begin
  6891.                 Version:=0;
  6892.                 MsgGroups:=3;
  6893.                 Protocol:=PROTO_XACC+PROTO_AV;
  6894.                 AVSrvMsg:=1024;
  6895.                 AVAccMsg:=0;
  6896.                 AppTypeMR:='';
  6897.                 AppTypeHR:=nil;
  6898.                 ExtFeatures:=nil;
  6899.                 GenericName:=nil;
  6900.                 pXDSC:=nil
  6901.             end;
  6902.         XAccAttr.apID:=apID;
  6903.         XAccAttr.menuID:=menuID;
  6904.         XAccAttr.Name:=Name
  6905.     end;
  6906.  
  6907.  
  6908. function TApplication.SendWndMessage(gHnd: integer; Msg: pointer; sID,Icn: boolean): boolean;
  6909.     var aid,dummy,opn: integer;
  6910.         pw           : PWindow;
  6911.  
  6912.     begin
  6913.         SendWndMessage:=false;
  6914.         if Msg=nil then exit;
  6915.         if gHnd<=DESK then wind_get(DESK,WF_TOP,gHnd,dummy,dummy,dummy);
  6916.         if gHnd<=DESK then exit;
  6917.         if sID then PPipearray(Msg)^[1]:=apID;
  6918.         PPipearray(Msg)^[2]:=0;
  6919.         PPipearray(Msg)^[3]:=gHnd;
  6920.         if agi.Owner then wind_get(gHnd,WF_OWNER,aid,dummy,dummy,dummy)
  6921.         else
  6922.             if GetGPWindow(gHnd)=nil then aid:=-1
  6923.             else
  6924.                 aid:=apID;
  6925.         if not(Icn) then
  6926.             begin
  6927.                 if aid=apID then
  6928.                     begin
  6929.                         pw:=GetGPWindow(gHnd);
  6930.                         if pw<>nil then
  6931.                             if pw^.IsIconified then exit
  6932.                     end;
  6933.                 if agi.Iconify then
  6934.                     begin
  6935.                         wind_get(gHnd,WF_ICONIFY,opn,dummy,dummy,dummy);
  6936.                         if opn<>0 then exit
  6937.                     end
  6938.             end;
  6939.         if aid<0 then Broadcast(Msg,false)
  6940.         else
  6941.             appl_write(aid,16,Msg);
  6942.         SendWndMessage:=true
  6943.     end;
  6944.  
  6945.  
  6946. procedure TApplication.Broadcast(Msg: pointer; sID: boolean);
  6947.     var p         : PXAccAttr;
  6948.         q,atyp,aid: integer;
  6949.         fname     : string;
  6950.  
  6951.     begin
  6952.         if Msg=nil then exit;
  6953.         if sID then PPipearray(Msg)^[1]:=apID;
  6954.         PPipearray(Msg)^[2]:=0;
  6955.         if agi.Broadcast then
  6956.             begin
  6957.                 with AES_pb do
  6958.                     begin
  6959.                         control^[0]:=121;
  6960.                         control^[1]:=3;
  6961.                         control^[2]:=1;
  6962.                         control^[3]:=2;
  6963.                         control^[4]:=0;
  6964.                         intin^[0]:=7;
  6965.                         intin^[1]:=0;
  6966.                         intin^[2]:=0;
  6967.                         addrin^[0]:=Msg;
  6968.                         addrin^[1]:=nil
  6969.                     end;
  6970.                 _crystal(@AES_pb)
  6971.             end
  6972.         else
  6973.             if agi.ApplSearch then
  6974.                 begin
  6975.                     q:=appl_search(0,fname,atyp,aid);
  6976.                     while q=1 do
  6977.                         begin
  6978.                             if (atyp<>1) and (aid<>apID) then appl_write(aid,16,Msg);
  6979.                             q:=appl_search(1,fname,atyp,aid)
  6980.                         end
  6981.                 end
  6982.             else
  6983.                 if XAccList<>nil then
  6984.                     with XAccList^ do
  6985.                         if Count>0 then
  6986.                             for q:=0 to Count-1 do
  6987.                                 begin
  6988.                                     p:=At(q);
  6989.                                     if p<>nil then appl_write(p^.apID,16,Msg)
  6990.                                 end
  6991.     end;
  6992.  
  6993.  
  6994. function TApplication.FindApplication(AName: string; AnID: integer; var XAccAttr: TXAccAttr): boolean;
  6995.     var p: PXAccAttr;
  6996.         q: longint;
  6997.  
  6998.     begin
  6999.         FindApplication:=false;
  7000.         lastfa:=-1;
  7001.         if (length(AName)=0) and (AnID<0) then exit;
  7002.         if XAccList<>nil then
  7003.             with XAccList^ do
  7004.                 if Count>0 then
  7005.                     for q:=0 to Count-1 do
  7006.                         begin
  7007.                             p:=At(q);
  7008.                             if p<>nil then
  7009.                                 begin
  7010.                                     if length(AName)>0 then
  7011.                                         begin
  7012.                                             if p^.Name^=AName then
  7013.                                                 begin
  7014.                                                     XAccAttr:=p^;
  7015.                                                     FindApplication:=true;
  7016.                                                     lastfa:=q;
  7017.                                                     exit
  7018.                                                 end
  7019.                                         end
  7020.                                     else
  7021.                                         if p^.apID=AnID then
  7022.                                             begin
  7023.                                                 XAccAttr:=p^;
  7024.                                                 FindApplication:=true;
  7025.                                                 lastfa:=q;
  7026.                                                 exit
  7027.                                             end
  7028.                                 end
  7029.                         end
  7030.     end;
  7031.  
  7032.  
  7033. function TApplication.FirstApplication(AType: TAppTypeMR; GenName: string; var XAccAttr: TXAccAttr): boolean;
  7034.  
  7035.     begin
  7036.         DisposeStr(nappgen);
  7037.         nappgen:=NewStr(GenName);
  7038.         nxtapp:=0;
  7039.         napptype:=AType;
  7040.         FirstApplication:=NextApplication(XAccAttr)
  7041.     end;
  7042.  
  7043.  
  7044. function TApplication.NextApplication(var XAccAttr: TXAccAttr): boolean;
  7045.     label _weiter;
  7046.  
  7047.     begin
  7048.         NextApplication:=false;
  7049.         if XAccList=nil then exit;
  7050.         with XAccList^ do
  7051.             while nxtapp<Count do
  7052.                 begin
  7053.                     if At(nxtapp)=nil then goto _weiter;
  7054.                     with PXaccAttr(At(nxtapp))^ do
  7055.                         begin
  7056.                             if napptype<>'  ' then
  7057.                                 if napptype<>AppTypeMR then goto _weiter;
  7058.                             if nappgen<>nil then
  7059.                                 if GenericName<>nil then
  7060.                                     if nappgen^<>GenericName^ then goto _weiter;
  7061.                             NextApplication:=true;
  7062.                             XAccAttr:=PXaccAttr(At(nxtapp))^;
  7063.                             inc(nxtapp);
  7064.                             exit
  7065.                         end;
  7066.                     _weiter:
  7067.                     inc(nxtapp)
  7068.                 end
  7069.     end;
  7070.  
  7071.  
  7072. procedure TApplication.FreeResource;
  7073.     var q: integer;
  7074.  
  7075.     begin
  7076.         if RscPtr<>nil then
  7077.             begin
  7078.                 if RscPtr=RSC_LOADED then
  7079.                     begin
  7080.                         if rsrc_free<>0 then
  7081.                             begin
  7082.                                 for q:=5 to 9 do GEM_pb.global[q]:=0;
  7083.                                 RscPtr:=nil
  7084.                             end
  7085.                     end
  7086.                 else
  7087.                     begin
  7088.                         FixResource(RscPtr,UNFIXRSC,FIX_ALL);
  7089.                         for q:=5 to 9 do GEM_pb.global[q]:=0;
  7090.                         RscPtr:=nil
  7091.                     end
  7092.             end
  7093.     end;
  7094.  
  7095.  
  7096. procedure TApplication.InstallDesktop(tIndx,oIndx: integer);
  7097.     var tp: PTree;
  7098.  
  7099.     begin
  7100.         tp:=GetAddr(tIndx);
  7101.         if (tp<>nil) and AppFlag then
  7102.             begin
  7103.                 with DRect do
  7104.                     begin
  7105.                         tp^[ROOT].ob_x:=X;
  7106.                         tp^[ROOT].ob_y:=Y;
  7107.                         tp^[ROOT].ob_width:=W;
  7108.                         tp^[ROOT].ob_height:=H
  7109.                     end;
  7110.                 wind_set(DESK,WF_NEWDESK,integer(HiWord(tp)),integer(LoWord(tp)),oIndx,0);
  7111.                 deskinst:=true;
  7112.                 DeskRedraw
  7113.             end
  7114.     end;
  7115.  
  7116.  
  7117. procedure TApplication.RemoveDesktop;
  7118.  
  7119.     begin
  7120.         if AppFlag and deskinst then
  7121.             begin
  7122.                 wind_set(DESK,WF_NEWDESK,0,0,0,0);
  7123.                 deskinst:=false;
  7124.                 DeskRedraw
  7125.             end
  7126.     end;
  7127.  
  7128.  
  7129. procedure TApplication.LoadIcon(icnTree,icnIndx: integer);
  7130.  
  7131.     begin
  7132.         if (ticn=-1) and (icnTree>=0) and (icnIndx>=ROOT) then
  7133.             begin
  7134.                 ticn:=icnTree;
  7135.                 iicn:=icnIndx;
  7136.                 if IsIconified then
  7137.                     if icnwnd<>nil then
  7138.                         begin
  7139.                             new(Icon,Init(icnwnd,ticn,iicn,0,0,false,false,'',''));
  7140.                             icnwnd^.LoadIcon(Icon)
  7141.                         end
  7142.             end
  7143.     end;
  7144.  
  7145.  
  7146. procedure TApplication.FreeIcon;
  7147.  
  7148.     begin
  7149.         if ticn<>-1 then
  7150.             begin
  7151.                 if IsIconified then
  7152.                     if icnwnd<>nil then icnwnd^.FreeIcon;
  7153.                 Icon:=nil;
  7154.                 ticn:=-1
  7155.             end
  7156.     end;
  7157.  
  7158.  
  7159. procedure TApplication.LoadMenu(Indx: integer);
  7160.     var tp   : PTree;
  7161.         pipe : Pipearray;
  7162.         dummy: integer;
  7163.  
  7164.     begin
  7165.         tp:=GetAddr(Indx);
  7166.         if (MenuTree=nil) and (tp<>nil) and AppFlag then
  7167.             begin
  7168.                 MenuTree:=tp;
  7169.                 if MenuCorrect(MenuTree,dummy) then
  7170.                     begin
  7171.                         if bTst(Attr.Style,as_MenuSeparator) then MenuTune;
  7172.                         if menu_bar(MenuTree,ME_DRAW)=0 then
  7173.                             begin
  7174.                                 MenuTree:=nil;
  7175.                                 Err:=em_InvalidMenu
  7176.                             end
  7177.                         else
  7178.                             begin
  7179.                                 new(menuentries);
  7180.                                 if menuentries<>nil then
  7181.                                     begin
  7182.                                         GetMenuEntries(menuentries^);
  7183.                                         pipe[0]:=GO_PRIVATE;
  7184.                                         pipe[1]:=apID;
  7185.                                         pipe[2]:=0;
  7186.                                         pipe[3]:=GOP_SETQUIT;
  7187.                                         pipe[4]:=menuentries^.Quit.Entry;
  7188.                                         pipe[5]:=menuentries^.Quit.Title;
  7189.                                         appl_write(apID,16,@pipe)
  7190.                                     end
  7191.                             end
  7192.                     end
  7193.                 else
  7194.                     begin
  7195.                         MenuTree:=nil;
  7196.                         Err:=em_InvalidMenu
  7197.                     end
  7198.             end
  7199.         else
  7200.             Err:=em_InvalidMenu
  7201.     end;
  7202.  
  7203.  
  7204. procedure TApplication.DrawMenu;
  7205.  
  7206.     begin
  7207.         if MenuTree<>nil then
  7208.             begin
  7209.                 if agi.MenuInq then
  7210.                     begin
  7211.                         wind_update(BEG_UPDATE);
  7212.                         if menu_bar(nil,ME_INQUIRE)=apID then menu_bar(MenuTree,ME_DRAW);
  7213.                         wind_update(END_UPDATE)
  7214.                     end
  7215.                 else
  7216.                     menu_bar(MenuTree,ME_DRAW)
  7217.             end
  7218.     end;
  7219.  
  7220.  
  7221. procedure TApplication.FreeMenu;
  7222.  
  7223.     begin
  7224.         if MenuTree<>nil then
  7225.             if menu_bar(nil,ME_ERASE)<>0 then MenuTree:=nil;
  7226.         if menuentries<>nil then dispose(menuentries);
  7227.         menuentries:=nil
  7228.     end;
  7229.  
  7230.  
  7231. function TApplication.AutoFolder: boolean;
  7232.  
  7233.     begin
  7234.         AutoFolder:=false
  7235.     end;
  7236.  
  7237.  
  7238. procedure TApplication.InitGEM;
  7239.     label _notempty;
  7240.  
  7241.   var i         : integer;
  7242.       scmd,stail: string;
  7243.       penv,dummy: pointer;
  7244.  
  7245.   begin
  7246.       GEM_pb.global[0]:=0;
  7247.       apID:=appl_init;
  7248.       if GEM_pb.global[0]=0 then
  7249.           begin
  7250.               if not(AutoFolder) then
  7251.                   begin
  7252.                       if (Attr.Country=FRG) or (Attr.Country=SWG) then
  7253.                           writeln(#27'p'+Name^+#27'q: AES nicht aktiv -> Abbruch!')
  7254.                       else
  7255.                           writeln(#27'p'+Name^+#27'q: AES not active -> quit!')
  7256.                   end;
  7257.               apID:=-1;
  7258.               Status:=em_AESNotActive;
  7259.               Err:=Status;
  7260.               exit
  7261.           end;
  7262.       if apID>=0 then
  7263.       begin
  7264.           i:=shel_read(scmd,stail);
  7265.           if AppFlag then BusyMouse;
  7266.             MultiTOS:=(GEMVersion>=$0400) and (GEM_pb.global[1]=-1);
  7267.                 if MiNTActive or MultiTOS then
  7268.                     begin
  7269.                         Psignal(SIGTERM,@SigHandler);
  7270.                         Psignal(SIGQUIT,@SigHandler)
  7271.                     end;
  7272.           if i<>0 then
  7273.               begin
  7274.                   if paramcount>0 then
  7275.                       if length(StrPTrimF(paramstr(0)))<>0 then goto _notempty;
  7276.                   StrPTrim(scmd);
  7277.                         stail:=StrPTrimF(System.copy(stail,2,Min(ord(stail[1]),125)))
  7278.               end
  7279.           else
  7280.               begin
  7281.                   _notempty:
  7282.                   scmd:='';
  7283.                   stail:=''
  7284.               end;
  7285.           if length(scmd)=0 then
  7286.               if paramcount>0 then
  7287.                   if length(StrPTrimF(paramstr(0)))>0 then scmd:=StrPTrimF(paramstr(0));
  7288.           if length(stail)=0 then
  7289.               begin
  7290.                   if paramcount>0 then
  7291.                       begin
  7292.                           i:=1;
  7293.                           repeat
  7294.                               if length(stail)+length(paramstr(i))>=254 then i:=paramcount
  7295.                               else
  7296.                                   stail:=stail+paramstr(i)+' ';
  7297.                               inc(i)
  7298.                           until (i>=paramcount)
  7299.                       end
  7300.                   else
  7301.                       if AppFlag then
  7302.                           if PByte(longint(BasePage)+$80)^>0 then
  7303.                               stail:=StrLPas(pointer(longint(BasePage)+$81),Min(PByte(longint(BasePage)+$80)^,125));
  7304.                   StrPTrim(stail)
  7305.               end;
  7306.                 if StrPLeft(scmd,1)='\' then
  7307.                     begin
  7308.                         if AppFlag then scmd:=chr(dgetdrv+65)+':'+scmd
  7309.                         else
  7310.                             scmd:=BootDevice+':'+scmd
  7311.                     end;
  7312.                 if StrPRight(StrPLeft(scmd,2),1)<>':' then
  7313.                     begin
  7314.                          if AppFlag then scmd:=chr(dgetdrv+65)+':\'+scmd
  7315.                          else
  7316.                              scmd:=BootDevice+':\'+scmd
  7317.                     end;
  7318.                 Attr.rpCmd:=NewStr(scmd);
  7319.                 if length(stail)>0 then Attr.rpTail:=NewStr(stail);
  7320.             aesHandle:=graf_handle(Attr.charSWidth,Attr.charSHeight,Attr.boxSWidth,Attr.boxSHeight);
  7321.             for i:=0 to 9 do workIn[i]:=1;
  7322.             workIn[10]:=RC;
  7323.             vdiHandle:=aesHandle;
  7324.             v_opnvwk(workIn,vdiHandle,workOut);
  7325.             if vdiHandle<=0 then
  7326.               begin
  7327.                   if AppFlag or MultiTOS then
  7328.                       begin
  7329.                           appl_exit;
  7330.                           apID:=-1;
  7331.                           Status:=em_GEMInitFailure;
  7332.                           Err:=Status
  7333.                       end
  7334.                   else
  7335.                       while true do evnt_timer(0,1)
  7336.                 end
  7337.               else
  7338.                   begin
  7339.                         Status:=em_OK;
  7340.                         menuID:=-1;
  7341.                         if not(AppFlag) or MultiTOS then
  7342.                             begin
  7343.                                 menuID:=menu_register(apID,'  '+StrPLeft(Name^,17)+' ');
  7344.                                 if (menuID<0) and not(AppFlag) then
  7345.                                     begin
  7346.                                         Status:=em_AccInitFailure;
  7347.                                         Err:=Status
  7348.                                     end
  7349.                             end
  7350.                     end
  7351.             end
  7352.       else
  7353.           begin
  7354.                Status:=em_GEMInitFailure;
  7355.                Err:=Status
  7356.            end
  7357.   end;
  7358.  
  7359.  
  7360. procedure    TApplication.ExitGEM;
  7361.  
  7362.   begin
  7363.       if apID>=0 then
  7364.           begin
  7365.                 RemoveDesktop;
  7366.                 FreeIcon;
  7367.                 FreeMenu;
  7368.                 FreeResource
  7369.           end;
  7370.       if vdiHandle>0 then
  7371.           begin
  7372.                 if bTst(Attr.Style,as_LoadFonts) then
  7373.                     if GDOSActive then vst_unload_fonts(vdiHandle,0);
  7374.               v_clsvwk(vdiHandle);
  7375.               vdiHandle:=-1
  7376.             end;
  7377.       if apID>=0 then
  7378.           begin
  7379.                 appl_exit;
  7380.                 apID:=-1
  7381.             end
  7382.     end;
  7383.  
  7384.  
  7385. procedure TApplication.SetupVDI;
  7386.     var dummy: string[33];
  7387.  
  7388.     begin
  7389.         spderr:=0;
  7390.         if GDOSActive then
  7391.             if bTst(Attr.Style,as_LoadFonts) then Attr.addFonts:=vst_load_fonts(vdiHandle,0);
  7392.         if spderr<>0 then Err:=em_SpeedoLoadFailure;
  7393.         vsl_udsty(vdiHandle,$5555);
  7394.         vsm_height(vdiHandle,1);
  7395.         vst_font(vdiHandle,vqt_name(vdiHandle,1,dummy));
  7396.         vst_height(vdiHandle,SysInfo.SFHeight,GP.charWidth,GP.charHeight,GP.boxWidth,GP.boxHeight);
  7397.         vst_alignment(vdiHandle,TA_LEFT,TA_BASELINE,GP.horAlign,GP.verAlign);
  7398.         vsf_interior(vdiHandle,FIS_HOLLOW);
  7399.         vsf_style(vdiHandle,0);
  7400.         vs_clip(vdiHandle,CLIP_ON,DRect.A2);
  7401.         GP.trotation:=0;
  7402.         GP.fperimeter:=PER_ON;
  7403.         GP.teffects:=TF_NORMAL;
  7404.         GP.wrmode:=MD_REPLACE;
  7405.         GP.lendsb:=LE_SQUARED;
  7406.         GP.lendse:=LE_SQUARED;
  7407.         GP.ltype:=LT_SOLID;
  7408.         GP.mtype:=MT_DOT;
  7409.         GP.lcolor:=Black;
  7410.         GP.mcolor:=Black;
  7411.         GP.tcolor:=Black;
  7412.         GP.fcolor:=Black;
  7413.         GP.lwidth:=1
  7414.     end;
  7415.  
  7416.  
  7417. procedure TApplication.InitApplication;
  7418.  
  7419.   begin
  7420.     FirstInstance:=true;
  7421.     if Attr.Instance=$42 then
  7422.         begin
  7423.             if NewCookie(ID,getcval+1) then Attr.Instance:=1
  7424.             else
  7425.                 Attr.Instance:=0
  7426.         end
  7427.   end;
  7428.  
  7429.  
  7430. procedure TApplication.InitInstance;
  7431.  
  7432.   begin
  7433.         if Status>=em_OK then
  7434.             begin
  7435.                 if (AppFlag or MultiTOS) then pquit:=new(PQKey,Init(@self,K_CTRL,Ctrl_Quit,-1,-1));
  7436.                 if bTst(Attr.Style,as_HandleShutdown) then
  7437.                     if agi.Shutdown then shel_write(9,1,0,'','');
  7438.                 InitMainWindow
  7439.             end
  7440.   end;
  7441.  
  7442.  
  7443. procedure TApplication.InitMainWindow;
  7444.  
  7445.     begin
  7446.         new(PWindow,Init(nil,Name^));
  7447.         if (MainWindow=nil) or (Err<em_OK) then Status:=em_InvalidMainWindow
  7448.     end;
  7449.  
  7450.  
  7451. function TApplication.GetCurrInstance: integer;
  7452.     var ret: longint;
  7453.  
  7454.     begin
  7455.         ret:=0;
  7456.         if Attr.Instance>0 then
  7457.             if GetCookie(ID,ret) then ret:=(ret and $ff);
  7458.         GetCurrInstance:=ret
  7459.     end;
  7460.  
  7461.  
  7462. function TApplication.GetGPWindow(gHnd: integer): PWindow;
  7463.     var p,pc,pc2: PWindow;
  7464.  
  7465.     begin
  7466.         GetGPWindow:=nil;
  7467.         if gHnd<0 then exit;
  7468.         p:=MainWindow;
  7469.         while (p<>nil) do
  7470.             begin
  7471.                 with p^ do
  7472.                     begin
  7473.                         if Attr.gemHandle=gHnd then
  7474.                             begin
  7475.                                 GetGPWindow:=p;
  7476.                                 exit
  7477.                             end;
  7478.                         pc:=ChildList
  7479.                     end;
  7480.                 if (pc<>nil) then
  7481.                     begin
  7482.                         while (pc^.ChildList<>nil) do pc:=pc^.ChildList;
  7483.                         repeat
  7484.                             pc2:=pc;
  7485.                             while (pc2<>nil) do
  7486.                                 with pc2^ do
  7487.                                     begin
  7488.                                         if Attr.gemHandle=gHnd then
  7489.                                             begin
  7490.                                                 GetGPWindow:=pc2;
  7491.                                                 exit
  7492.                                             end;
  7493.                                         pc2:=Nxt
  7494.                                     end;
  7495.                             pc:=pc^.Parent
  7496.                         until pc=p
  7497.                     end;
  7498.                 p:=p^.Nxt
  7499.             end
  7500.     end;
  7501.  
  7502.  
  7503. function TApplication.GetPWindow(Hnd: HWnd): PWindow;
  7504.     var p,pc,pc2: PWindow;
  7505.  
  7506.     begin
  7507.         p:=MainWindow;
  7508.         while (p<>nil) do
  7509.             begin
  7510.                 with p^ do
  7511.                     begin
  7512.                         if Attr.Handle=Hnd then
  7513.                             begin
  7514.                                 GetPWindow:=p;
  7515.                                 exit
  7516.                             end;
  7517.                         pc:=ChildList
  7518.                     end;
  7519.                 if (pc<>nil) then
  7520.                     begin
  7521.                         while (pc^.ChildList<>nil) do pc:=pc^.ChildList;
  7522.                         repeat
  7523.                             pc2:=pc;
  7524.                             while (pc2<>nil) do
  7525.                                 with pc2^ do
  7526.                                     begin
  7527.                                         if Attr.Handle=Hnd then
  7528.                                             begin
  7529.                                                 GetPWindow:=pc2;
  7530.                                                 exit
  7531.                                             end;
  7532.                                         pc2:=Nxt
  7533.                                     end;
  7534.                             pc:=pc^.Parent
  7535.                         until pc=p
  7536.                     end;
  7537.                 p:=p^.Nxt
  7538.             end;
  7539.         GetPWindow:=nil
  7540.     end;
  7541.  
  7542.  
  7543. function TApplication.GetPTopWindow: PWindow;
  7544.     var top,dummy: integer;
  7545.  
  7546.     begin
  7547.         wind_get(DESK,WF_TOP,top,dummy,dummy,dummy);
  7548.         GetPTopWindow:=GetGPWindow(top)
  7549.     end;
  7550.  
  7551.  
  7552. function TApplication.GetMsTimer: longint;
  7553.  
  7554.     begin
  7555.         GetMsTimer:=1000
  7556.     end;
  7557.  
  7558.  
  7559. procedure TApplication.GetCrsRect(var crect: GRECT);
  7560.  
  7561.     begin
  7562.         if pcrswatch<>nil then crect:=pcrswatch^.Work
  7563.     end;
  7564.  
  7565.  
  7566. function TApplication.GetEvent(var data: TEventData): integer;
  7567.     var crect: GRECT;
  7568.  
  7569.     begin
  7570.         GetCrsRect(crect);
  7571.         GetEvent:=evnt_multi(Attr.EventMask,258,3,0,0,crect.X,crect.Y,crect.W,crect.H,
  7572.                                                  1,crect.X,crect.Y,crect.W,crect.H,data.Pipe,GetMsTimer mod 65536,
  7573.                                                  GetMsTimer div 65536,data.mX,data.mY,data.BStat,data.KStat,data.Key,data.Clicks)
  7574.     end;
  7575.  
  7576.  
  7577. procedure TApplication.MessageLoop;
  7578.     var data : TEventData;
  7579.             event: integer;
  7580.  
  7581.   begin
  7582.       repeat
  7583.           Status:=em_OK;
  7584.             while (Status>=em_OK) do
  7585.                 begin
  7586.                   event:=GetEvent(data);
  7587.                     if bTst(event,MU_M1) then MUM1(data);
  7588.                     if bTst(event,MU_M2) then MUM2(data);
  7589.                     if bTst(event,MU_KEYBD) then MUKeybd(data);
  7590.                     if bTst(event,MU_BUTTON) then MUButton(data);
  7591.                     if bTst(event,MU_MESAG) then MUMesag(data);
  7592.                     if bTst(event,MU_TIMER) then MUTimer(data)
  7593.                 end;
  7594.             if Status=em_Terminate then break;
  7595.             HandleError;
  7596.             if Status>=em_OK then continue
  7597.         until (Status<>em_Quit) or CanClose
  7598.   end;
  7599.  
  7600.  
  7601. procedure TApplication.MUKeybd(data: TEventData);
  7602.     var p    : PEvent;
  7603.         pw   : PWindow;
  7604.         dummy: integer;
  7605.  
  7606.     procedure WIconify;
  7607.         var ICFGetPos: function(d1,d2: pointer; d3,d4,d5: longint; fn: integer; px,py,pb,ph: pointer): integer;
  7608.             x,y,w,h  : integer;
  7609.  
  7610.         begin
  7611.             if icfserver<>nil then
  7612.                 begin
  7613.                     ICFGetPos:=icfserver;
  7614.                     pw^.icfpos:=ICFGetPos(nil,nil,0,0,0,ICF_GETPOS,@x,@y,@w,@h);
  7615.                     if pw^.icfpos>=0 then
  7616.                         begin
  7617.                             pw^.GetCurr;
  7618.                             pw^.icfcurr:=pw^.Curr;
  7619.                             pw^.WMIconify(x,y,w,h)
  7620.                         end
  7621.                 end
  7622.         end;
  7623.  
  7624.     procedure WCycle;
  7625.         label _f_nochmal,_f_suchen,_b_nochmal,_b_suchen;
  7626.  
  7627.         var flag: boolean;
  7628.             p,wp: PWindow;
  7629.  
  7630.         begin
  7631.             flag:=false;
  7632.             wp:=pw;
  7633.             if (data.KStat and K_SHIFT)>0 then
  7634.                 begin
  7635.                     _b_nochmal:
  7636.                     p:=wp;
  7637.                     while p<>nil do
  7638.                         begin
  7639.                             if p^.CycleTop(pw,true) then exit;
  7640.                             p:=p^.Previous
  7641.                         end;
  7642.                     _b_suchen:
  7643.                     p:=wp^.Parent;
  7644.                     if p=nil then
  7645.                         begin
  7646.                             if flag then exit;
  7647.                             wp:=Application^.MainWindow;
  7648.                             while wp<>nil do
  7649.                                 begin
  7650.                                     if wp^.Next=nil then break;
  7651.                                     wp:=wp^.Next
  7652.                                 end;
  7653.                             flag:=true;
  7654.                             goto _b_nochmal
  7655.                         end;
  7656.                     wp:=p^.Previous;
  7657.                     if wp=nil then
  7658.                         begin
  7659.                             wp:=p;
  7660.                             goto _b_suchen
  7661.                         end
  7662.                     else
  7663.                         goto _b_nochmal
  7664.                 end
  7665.             else
  7666.                 begin
  7667.                     _f_nochmal:
  7668.                     p:=wp;
  7669.                     while p<>nil do
  7670.                         begin
  7671.                             if p^.CycleTop(pw,false) then exit;
  7672.                             p:=p^.Next
  7673.                         end;
  7674.                     _f_suchen:
  7675.                     p:=wp^.Parent;
  7676.                     if p=nil then
  7677.                         begin
  7678.                             if flag then exit;
  7679.                             wp:=Application^.MainWindow;
  7680.                             flag:=true;
  7681.                             goto _f_nochmal
  7682.                         end;
  7683.                     wp:=p^.Next;
  7684.                     if wp=nil then
  7685.                         begin
  7686.                             wp:=p;
  7687.                             goto _f_suchen
  7688.                         end
  7689.                     else
  7690.                         goto _f_nochmal
  7691.                 end
  7692.         end;
  7693.  
  7694.     procedure WClose;
  7695.         var wert: integer;
  7696.  
  7697.         begin
  7698.             wert:=pw^.Attr.Style;
  7699.             if pw^.IsIconified then
  7700.                 if pw^.icfpos>=0 then wert:=pw^.icfstyle;
  7701.             if bTst(wert,CLOSER) then pw^.WMClosed
  7702.         end;
  7703.  
  7704.     begin
  7705.         if not(allicn) then
  7706.             begin
  7707.                 if data.Key=Ctrl_Cycle then
  7708.                     if bTst(data.KStat,K_CTRL) then
  7709.                         begin
  7710.                             pw:=GetPTopWindow;
  7711.                             if pw=nil then exit;
  7712.                             if menuentries<>nil then
  7713.                                 if menuentries^.Cycle.Title>0 then
  7714.                                     if MenuTree<>nil then
  7715.                                         begin
  7716.                                             menu_tnormal(MenuTree,menuentries^.Cycle.Title,ME_INVERT);
  7717.                                             WCycle;
  7718.                                             menu_tnormal(MenuTree,menuentries^.Cycle.Title,ME_NORMAL);
  7719.                                             exit
  7720.                                         end;
  7721.                             WCycle;
  7722.                             exit
  7723.                         end;
  7724.                 if bTst(Attr.Style,as_XInputMode) then pw:=GetGPWindow(wind_find(data.mX,data.mY))
  7725.                 else
  7726.                     pw:=nil;
  7727.                 if pw=nil then pw:=GetPTopWindow;
  7728.                 if pw<>nil then
  7729.                     begin
  7730.                         if data.KStat=K_CTRL then
  7731.                             case data.Key of
  7732.                             Ctrl_Close:
  7733.                                 begin
  7734.                                     if menuentries<>nil then
  7735.                                         if menuentries^.Close.Title>0 then
  7736.                                             if MenuTree<>nil then
  7737.                                                 begin
  7738.                                                     menu_tnormal(MenuTree,menuentries^.Close.Title,ME_INVERT);
  7739.                                                     WClose;
  7740.                                                     menu_tnormal(MenuTree,menuentries^.Close.Title,ME_NORMAL);
  7741.                                                     exit
  7742.                                                 end;
  7743.                                     WClose;
  7744.                                     exit
  7745.                                 end;
  7746.                             Ctrl_Backdrop:
  7747.                                 begin
  7748.                                     pw^.WMBottomed;
  7749.                                     exit
  7750.                                 end
  7751.                             end;
  7752.                         if not(pw^.IsIconified) then
  7753.                             begin
  7754.                                 if data.KStat=K_CTRL then
  7755.                                     case data.Key of
  7756.                                     Ctrl_Iconify:
  7757.                                         begin
  7758.                                             WIconify;
  7759.                                             exit
  7760.                                         end;
  7761.                                     Ctrl_Fuller:
  7762.                                         begin
  7763.                                             if not(bTst(pw^.Attr.Style,FULLER)) then exit;
  7764.                                             if menuentries<>nil then
  7765.                                                 if menuentries^.Full.Title>0 then
  7766.                                                     if MenuTree<>nil then
  7767.                                                         begin
  7768.                                                             menu_tnormal(MenuTree,menuentries^.Full.Title,ME_INVERT);
  7769.                                                             pw^.WMFulled;
  7770.                                                             menu_tnormal(MenuTree,menuentries^.Full.Title,ME_NORMAL);
  7771.                                                             exit
  7772.                                                         end;
  7773.                                             pw^.WMFulled;
  7774.                                             exit
  7775.                                         end;
  7776.                                     Ctrl_A:
  7777.                                         begin
  7778.                                             pw^.SelectAll;
  7779.                                             exit
  7780.                                         end;
  7781.                                     Ctrl_P:
  7782.                                         begin
  7783.                                             pw^.Print;
  7784.                                             exit
  7785.                                         end;
  7786.                                     Ctrl_X:
  7787.                                         begin
  7788.                                             pw^.Cut;
  7789.                                             exit
  7790.                                         end;
  7791.                                     Ctrl_C:
  7792.                                         begin
  7793.                                             pw^.Copy;
  7794.                                             exit
  7795.                                         end;
  7796.                                     Ctrl_V:
  7797.                                         begin
  7798.                                             pw^.Paste;
  7799.                                             exit
  7800.                                         end
  7801.                                     end
  7802.                                 else
  7803.                                     if data.KStat=K_NORMAL then
  7804.                                         if data.Key=S_Delete then
  7805.                                             begin
  7806.                                                 pw^.Delete;
  7807.                                                 exit
  7808.                                             end;
  7809.                                 p:=pw^.EventList;
  7810.                                 while p<>nil do
  7811.                                     begin
  7812.                                         if p^.TestKey(data.KStat,data.Key) then exit;
  7813.                                         p:=p^.Next
  7814.                                     end
  7815.                             end
  7816.                         else
  7817.                             if (data.KStat=K_CTRL) and ((data.Key=Ctrl_Iconify) or (data.Key=Ctrl_Fuller)) then
  7818.                                 if pw^.icfpos>=0 then
  7819.                                     begin
  7820.                                         with pw^.icfcurr do pw^.WMUniconify(X,Y,W,H);
  7821.                                         exit
  7822.                                     end
  7823.                     end
  7824.             end;
  7825.         if data.KStat=K_CTRL then
  7826.             case data.Key of
  7827.             Ctrl_A:
  7828.                 begin
  7829.                     SelectAll;
  7830.                     exit
  7831.                 end;
  7832.             Ctrl_X:
  7833.                 begin
  7834.                     Cut;
  7835.                     exit
  7836.                 end;
  7837.             Ctrl_C:
  7838.                 begin
  7839.                     Copy;
  7840.                     exit
  7841.                 end;
  7842.             Ctrl_V:
  7843.                 begin
  7844.                     Paste;
  7845.                     exit
  7846.                 end
  7847.             end
  7848.         else
  7849.             if data.KStat=K_NORMAL then
  7850.                 if data.Key=S_Delete then
  7851.                     begin
  7852.                         Delete;
  7853.                         exit
  7854.                     end;
  7855.         p:=EventList;
  7856.         while p<>nil do
  7857.             begin
  7858.                 if p^.TestKey(data.KStat,data.Key) then exit;
  7859.                 p:=p^.Next
  7860.             end;
  7861.         HandleKeybd(data.KStat,data.Key)
  7862.     end;
  7863.  
  7864.  
  7865. procedure TApplication.MUButton(data: TEventData);
  7866.     label _desktop,_handle,_menu,_noentry;
  7867.  
  7868.     var p         : PEvent;
  7869.         pw        : PWindow;
  7870.         r         : GRECT;
  7871.         tbi,pdx,rx,
  7872.         ry,rw,rh,q: integer;
  7873.         ppop      : PMenuPopup;
  7874.         ICFGetPos : function(d1,d2: pointer; d3,d4,d5: longint; fn: integer; px,py,pb,ph: pointer): integer;
  7875.  
  7876.     begin
  7877.         p:=EventList;
  7878.         while p<>nil do
  7879.             begin
  7880.                 if p^.TestButton(data.mX,data.mY,data.BStat,data.KStat,data.Clicks) then exit;
  7881.                 p:=p^.Next
  7882.             end;
  7883.         if allicn then pw:=nil
  7884.         else
  7885.             pw:=GetGPWindow(wind_find(data.mX,data.mY));
  7886.         if pw<>nil then
  7887.             with pw^ do
  7888.                 if IsIconified then
  7889.                     begin
  7890.                         if (data.BStat=2) and (data.Clicks=2) then Top
  7891.                         else
  7892.                             if (data.BStat=1) and (icfpos>=0) then with icfcurr do WMUniconify(X,Y,W,H)
  7893.                             else
  7894.                                 goto _handle
  7895.                     end
  7896.                 else
  7897.                     begin
  7898.                         p:=EventList;
  7899.                         while p<>nil do
  7900.                             begin
  7901.                                 if p^.TestButton(data.mX,data.mY,data.BStat,data.KStat,data.Clicks) then exit;
  7902.                                 p:=p^.Next
  7903.                             end;
  7904.                         GRtoA2(Work);
  7905.                         if (data.mX>=Work.X1) and (data.mX<=Work.X2) and (data.mY>=Work.Y1) and (data.mY<=Work.Y2) then
  7906.                             WMButton(data.mX,data.mY,data.BStat,data.KStat,data.Clicks)
  7907.                         else
  7908.                             if (Class.ToolbarTree<>nil) or (Class.MenuTree<>nil) then
  7909.                                 begin
  7910.                                     wind_get(Attr.gemHandle,WF_WORKXYWH,rx,ry,rw,rh);
  7911.                                     if (data.mX>=rx) and (data.mX<rx+rw) and (data.mY>=ry) and (data.mY<ry+rh) then
  7912.                                         begin
  7913.                                             if (data.BStat=2) and (data.Clicks=2) then Top
  7914.                                             else
  7915.                                                 begin
  7916.                                                     tbi:=objc_find(Class.ToolbarTree,ROOT,MAX_DEPTH,data.mX,data.mY);
  7917.                                                     if tbi>ROOT then WMToolbar(tbi,data.BStat,data.KStat,data.Clicks)
  7918.                                                     else
  7919.                                                         if data.BStat=1 then
  7920.                                                             begin
  7921.                                                                 tbi:=objc_find(Class.MenuTree,Class.MenuTree^[ROOT].ob_head,MAX_DEPTH,data.mX,data.mY);
  7922.                                                                 pdx:=tbi-Class.MenuTree^[Class.MenuTree^[Class.MenuTree^[ROOT].ob_head].ob_head].ob_head;
  7923.                                                                 if pdx>=0 then
  7924.                                                                     begin
  7925.                                                                         wind_update(BEG_UPDATE);
  7926.                                                                         wind_update(BEG_MCTRL);
  7927.                                                                         _menu:
  7928.                                                                         TitleSelect(pw,tbi,true);
  7929.                                                                         rh:=Class.MenuTree^[Class.MenuTree^[ROOT].ob_tail].ob_head;
  7930.                                                                         while pdx>0 do
  7931.                                                                             begin
  7932.                                                                                 rh:=Class.MenuTree^[rh].ob_next;
  7933.                                                                                 dec(pdx)
  7934.                                                                             end;
  7935.                                                                         new(ppop,Init(pw,id_No,rh));
  7936.                                                                         pdx:=id_No;
  7937.                                                                         if ppop<>nil then
  7938.                                                                             with ppop^ do
  7939.                                                                                 begin
  7940.                                                                                     SetPopTree(Class.MenuTree);
  7941.                                                                                     objc_offset(PopTree,tbi,pX,pY);
  7942.                                                                                     pY:=PopTree^[PopTree^[ROOT].ob_head].ob_height+ry+1;
  7943.                                                                                     if PopTree^[pIndex].ob_height+pY>Application^.Attr.MaxPY then pY:=ry-PopTree^[pIndex].ob_height-1;
  7944.                                                                                     shadow:=false;
  7945.                                                                                     wait0:=false;
  7946.                                                                                     pdx:=Execute;
  7947.                                                                                     Free
  7948.                                                                                 end;
  7949.                                                                         if pdx>=10000 then
  7950.                                                                             begin
  7951.                                                                                 TitleSelect(pw,tbi,false);
  7952.                                                                                 dec(pdx,10000);
  7953.                                                                                 tbi:=pdx+Class.MenuTree^[Class.MenuTree^[Class.MenuTree^[ROOT].ob_head].ob_head].ob_head;
  7954.                                                                                 goto _menu
  7955.                                                                             end;
  7956.                                                                         if pdx<0 then TitleSelect(pw,tbi,false);
  7957.                                                                         repeat
  7958.                                                                             graf_mkstate(rx,rx,rw,rx)
  7959.                                                                         until rw=0;
  7960.                                                                         wind_update(END_MCTRL);
  7961.                                                                         if pdx>=0 then
  7962.                                                                             begin
  7963.                                                                                 inc(pdx,Class.MenuTree^[rh].ob_head);
  7964.                                                                                 q:=Class.MenuTree^[Class.MenuTree^[Class.MenuTree^[Class.MenuTree^[Class.MenuTree^[ROOT].ob_tail].ob_head].ob_head].ob_next].ob_next;
  7965.                                                                                 if pdx=q then
  7966.                                                                                     begin
  7967.                                                                                         data.Key:=Ctrl_Cycle;
  7968.                                                                                         data.KStat:=K_CTRL;
  7969.                                                                                         MUKeybd(data);
  7970.                                                                                         goto _noentry
  7971.                                                                                     end;
  7972.                                                                                 q:=Class.MenuTree^[q].ob_next;
  7973.                                                                                 if pdx=q then
  7974.                                                                                     begin
  7975.                                                                                         WMFulled;
  7976.                                                                                         goto _noentry
  7977.                                                                                     end;
  7978.                                                                                 q:=Class.MenuTree^[q].ob_next;
  7979.                                                                                 if pdx=q then
  7980.                                                                                     begin
  7981.                                                                                         if icfserver<>nil then
  7982.                                                                                             begin
  7983.                                                                                                 ICFGetPos:=icfserver;
  7984.                                                                                                 icfpos:=ICFGetPos(nil,nil,0,0,0,ICF_GETPOS,@rx,@ry,@rw,@rh);
  7985.                                                                                                 if icfpos>=0 then
  7986.                                                                                                     begin
  7987.                                                                                                         GetCurr;
  7988.                                                                                                         icfcurr:=Curr;
  7989.                                                                                                         WMIconify(rx,ry,rw,rh)
  7990.                                                                                                     end
  7991.                                                                                             end;
  7992.                                                                                         goto _noentry
  7993.                                                                                     end;
  7994.                                                                                 q:=Class.MenuTree^[q].ob_next;
  7995.                                                                                 if pdx=q then
  7996.                                                                                     begin
  7997.                                                                                         WMBottomed;
  7998.                                                                                         goto _noentry
  7999.                                                                                     end;
  8000.                                                                                 MNSelected(pdx,tbi,Class.MenuTree,rh);
  8001.                                                                                 _noentry:
  8002.                                                                                 TitleSelect(pw,tbi,false)
  8003.                                                                             end;
  8004.                                                                         wind_update(END_UPDATE)
  8005.                                                                     end
  8006.                                                             end
  8007.                                                 end
  8008.                                         end
  8009.                                     else
  8010.                                         goto _desktop
  8011.                                 end
  8012.                             else
  8013.                                 goto _desktop
  8014.                     end
  8015.         else
  8016.             begin
  8017.                 _desktop:
  8018.                 if (data.BStat=1) and (data.Clicks=1) and bTst(Attr.Style,as_Rubbox) then
  8019.                     begin
  8020.                         if (data.mX>=DRect.X1) and (data.mX<=DRect.X2) and (data.mY>=DRect.Y1) and (data.mY<=DRect.Y2) then
  8021.                             begin
  8022.                                 if (data.KStat and K_SHIFT)>0 then IconSelect(false,DESK)
  8023.                                 else
  8024.                                     IconSelect(false,id_No);
  8025.                                 if Rubbox(DESK,data.mX,data.mY,DRect.X1,DRect.Y1,DRect.X2,DRect.Y2,true,r) then MURubbox(r)
  8026.                             end
  8027.                     end
  8028.                 else
  8029.                     _handle:
  8030.                     HandleButton(data.mX,data.mY,data.BStat,data.KStat,data.Clicks)
  8031.             end
  8032.     end;
  8033.  
  8034.  
  8035. procedure TApplication.MURubbox(r: GRECT);
  8036.  
  8037.     begin
  8038.     end;
  8039.  
  8040.  
  8041. procedure TApplication.MURBoxChanged(r: GRECT);
  8042.  
  8043.     begin
  8044.     end;
  8045.  
  8046.  
  8047. procedure TApplication.MUM1(data: TEventData);
  8048.     var p         : PEvent;
  8049.         pw        : PWindow;
  8050.         found     : boolean;
  8051.  
  8052.     begin
  8053.         found:=false;
  8054.         p:=EventList;
  8055.         while (p<>nil) and not(found) do
  8056.             with p^ do
  8057.                 begin
  8058.                     found:=TestMouse(MU_M1,data.mX,data.mY,data.BStat,data.KStat);
  8059.                     p:=Nxt
  8060.                 end;
  8061.         if not(found) and not(allicn) then
  8062.             begin
  8063.                 pw:=GetPTopWindow;
  8064.                 if pw<>nil then
  8065.                     if not(pw^.IsIconified) then
  8066.                         begin
  8067.                             p:=pw^.EventList;
  8068.                             while (p<>nil) and not(found) do
  8069.                                 with p^ do
  8070.                                     begin
  8071.                                         found:=TestMouse(MU_M1,data.mX,data.mY,data.BStat,data.KStat);
  8072.                                         p:=Nxt
  8073.                                     end
  8074.                         end
  8075.             end;
  8076.         if not(found) then HandleM1(data.mX,data.mY,data.BStat,data.KStat)
  8077.     end;
  8078.     
  8079.     
  8080. procedure TApplication.MUM2(data: TEventData);
  8081.     var p         : PEvent;
  8082.         pw        : PWindow;
  8083.         found     : boolean;
  8084.  
  8085.     begin
  8086.         found:=false;
  8087.         p:=EventList;
  8088.         while (p<>nil) and not(found) do
  8089.             with p^ do
  8090.                 begin
  8091.                     found:=TestMouse(MU_M2,data.mX,data.mY,data.BStat,data.KStat);
  8092.                     p:=Nxt
  8093.                 end;
  8094.         if not(found) and not(allicn) then
  8095.             begin
  8096.                 pw:=GetPTopWindow;
  8097.                 if pw<>nil then
  8098.                     if not(pw^.IsIconified) then
  8099.                         begin
  8100.                             p:=pw^.EventList;
  8101.                             while (p<>nil) and not(found) do
  8102.                                 with p^ do
  8103.                                     begin
  8104.                                         found:=TestMouse(MU_M2,data.mX,data.mY,data.BStat,data.KStat);
  8105.                                         p:=Nxt
  8106.                                     end
  8107.                         end
  8108.             end;
  8109.         if not(found) then HandleM2(data.mX,data.mY,data.BStat,data.KStat)
  8110.     end;
  8111.  
  8112.  
  8113. procedure TApplication.MUMesag(data: TEventData);
  8114.     label _notop;
  8115.  
  8116.     var p,pw        : PWindow;
  8117.         pg          : PEvent;
  8118.         found       : boolean;
  8119.         ret,dummy,ks,
  8120.         rx,ry,rw,rh : integer;
  8121.             ICFGetPos   : function(d1,d2: pointer; d3,d4,d5: longint; fn: integer; px,py,pw,ph: pointer): integer;
  8122.  
  8123.     procedure shwr_ap_tfail(err: integer);
  8124.         var pipe: Pipearray;
  8125.  
  8126.         begin
  8127.             pipe[0]:=AP_TFAIL;
  8128.             pipe[1]:=err;
  8129.             with AES_pb do
  8130.                 begin
  8131.                     control^[0]:=121;
  8132.                     control^[1]:=3;
  8133.                     control^[2]:=1;
  8134.                     control^[3]:=2;
  8135.                     control^[4]:=0;
  8136.                     intin^[0]:=10;
  8137.                     intin^[1]:=0;
  8138.                     intin^[2]:=0;
  8139.                     addrin^[0]:=@pipe;
  8140.                     addrin^[1]:=nil
  8141.                 end;
  8142.             _crystal(@AES_pb)
  8143.         end;
  8144.  
  8145.     procedure xaccreply(used: boolean);
  8146.         var pipe: Pipearray;
  8147.  
  8148.         begin
  8149.             pipe[0]:=ACC_ACK;
  8150.             pipe[1]:=apID;
  8151.             pipe[2]:=0;
  8152.             if used then pipe[3]:=1
  8153.             else
  8154.                 pipe[3]:=0;
  8155.             appl_write(data.Pipe[1],16,@pipe)
  8156.         end;
  8157.  
  8158.     procedure goversionreply;
  8159.         var pipe: Pipearray;
  8160.  
  8161.         begin
  8162.             pipe[0]:=GO_PRIVATE;
  8163.             pipe[1]:=apID;
  8164.             pipe[2]:=0;
  8165.             pipe[3]:=GOP_VERSION;
  8166.             pipe[4]:=GOVersion;
  8167.             pipe[5]:=0;
  8168.             pipe[6]:=0;
  8169.             pipe[7]:=0;
  8170.             appl_write(data.Pipe[1],16,@pipe)
  8171.         end;
  8172.  
  8173.     begin
  8174.         wind_update(BEG_UPDATE);
  8175.         if MessageBuffer<>nil then
  8176.             begin
  8177.                 freemem(MessageBuffer,MessageBLen);
  8178.                 MessageBuffer:=nil
  8179.             end;
  8180.         MessageBLen:=data.Pipe[2];
  8181.         if MessageBLen>0 then
  8182.             begin
  8183.                 if data.Pipe[0]<>24 then getmem(MessageBuffer,MessageBLen);
  8184.                 if MessageBuffer<>nil then appl_read(apID,MessageBLen,MessageBuffer)
  8185.                 else
  8186.                     MessageBLen:=0
  8187.             end;
  8188.         case data.Pipe[0] of
  8189.         MN_SELECTED:
  8190.             if agi.ExtMnSelect then
  8191.                 MNSelected(data.Pipe[4],data.Pipe[3],Ptr(word(data.Pipe[5]),word(data.Pipe[6])),data.Pipe[7])
  8192.             else
  8193.                 MNSelected(data.Pipe[4],data.Pipe[3],nil,0);
  8194.         WM_REDRAW:
  8195.             begin
  8196.                 p:=GetGPWindow(data.Pipe[3]);
  8197.                 if p<>nil then p^.WMRedraw(data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7])
  8198.             end;
  8199.         WM_TOPPED:
  8200.             begin
  8201.                 p:=GetGPWindow(data.Pipe[3]);
  8202.                 if p<>nil then
  8203.                     begin
  8204.                         if p^.IsIconified then
  8205.                             if p^.icfpos>=0 then
  8206.                                 begin
  8207.                                     with p^.icfcurr do p^.WMUniconify(X,Y,W,H);
  8208.                                     goto _notop
  8209.                                 end;
  8210.                         if bTst(p^.Class.Style,cs_WorkBackground) then
  8211.                             begin
  8212.                                 graf_mkstate(data.mX,data.mY,dummy,data.KStat);
  8213.                                 wind_get(p^.Attr.gemHandle,WF_WORKXYWH,rx,ry,rw,rh);
  8214.                                 if Between(data.mX,rx,rx+rw-1) and Between(data.mY,ry,ry+rh-1) then
  8215.                                     begin
  8216.                                         data.BStat:=1;
  8217.                                         data.Clicks:=1;
  8218.                                         MUButton(data);
  8219.                                         goto _notop
  8220.                                     end
  8221.                             end;
  8222.                         p^.WMTopped;
  8223.                         _notop:
  8224.                     end
  8225.             end;
  8226.         WM_CLOSED:
  8227.             begin
  8228.                 graf_mkstate(dummy,dummy,dummy,ks);
  8229.                 p:=GetGPWindow(data.Pipe[3]);
  8230.                 if p<>nil then
  8231.                     begin
  8232.                         if (ks and (K_SHIFT or K_ALT or K_CTRL))<>0 then
  8233.                             begin
  8234.                                 if bTst(ks,K_ALT) and (icfserver<>nil) and not(p^.IsIconified) then
  8235.                                     begin
  8236.                                         ICFGetPos:=icfserver;
  8237.                                         p^.icfpos:=ICFGetPos(nil,nil,0,0,0,ICF_GETPOS,@data.Pipe[4],@data.Pipe[5],@data.Pipe[6],@data.Pipe[7]);
  8238.                                         if p^.icfpos>=0 then
  8239.                                             begin
  8240.                                                 p^.GetCurr;
  8241.                                                 p^.icfcurr:=p^.Curr;
  8242.                                                 p^.WMIconify(data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7])
  8243.                                             end
  8244.                                     end
  8245.                             end
  8246.                         else
  8247.                             begin
  8248.                                 dummy:=p^.Attr.Style;
  8249.                                 if p^.IsIconified then
  8250.                                     if p^.icfpos>=0 then dummy:=p^.icfstyle;
  8251.                                 if bTst(dummy,CLOSER) then p^.WMClosed
  8252.                             end
  8253.                     end
  8254.             end;
  8255.         WM_FULLED:
  8256.             begin
  8257.                 p:=GetGPWindow(data.Pipe[3]);
  8258.                 if p<>nil then p^.WMFulled
  8259.             end;
  8260.         WM_ARROWED:
  8261.             begin
  8262.                 p:=GetGPWindow(data.Pipe[3]);
  8263.                 if p<>nil then
  8264.                     begin
  8265.                         if data.Pipe[5]>=0 then data.Pipe[5]:=-1;
  8266.                         if data.Pipe[7]>=0 then
  8267.                             begin
  8268.                                 data.Pipe[6]:=0;
  8269.                                 data.Pipe[7]:=0
  8270.                             end;
  8271.                         p^.WMArrowed(data.Pipe[4],-data.Pipe[5],data.Pipe[6],-data.Pipe[7])
  8272.                     end
  8273.             end;
  8274.         WM_HSLID:
  8275.             begin
  8276.                 p:=GetGPWindow(data.Pipe[3]);
  8277.                 if p<>nil then p^.WMHSlid(data.Pipe[4])
  8278.             end;
  8279.         WM_VSLID:
  8280.             begin
  8281.                 p:=GetGPWindow(data.Pipe[3]);
  8282.                 if p<>nil then p^.WMVSlid(data.Pipe[4])
  8283.             end;
  8284.         WM_SIZED:
  8285.             begin
  8286.                 p:=GetGPWindow(data.Pipe[3]);
  8287.                 if p<>nil then p^.WMSized(data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7])
  8288.             end;
  8289.         WM_MOVED:
  8290.             begin
  8291.                 p:=GetGPWindow(data.Pipe[3]);
  8292.                 if p<>nil then p^.WMMoved(data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7])
  8293.             end;
  8294.         WM_NEWTOP:
  8295.             begin
  8296.                 p:=GetGPWindow(data.Pipe[3]);
  8297.                 if p<>nil then p^.WMNewTop
  8298.             end;
  8299.         WM_UNTOPPED:
  8300.             begin
  8301.                 p:=GetGPWindow(data.Pipe[3]);
  8302.                 if p<>nil then p^.WMUntopped
  8303.             end;
  8304.         WM_ONTOP:
  8305.             begin
  8306.                 p:=GetGPWindow(data.Pipe[3]);
  8307.                 if p<>nil then p^.WMOnTop
  8308.             end;
  8309.         WM_SHADED:
  8310.             begin
  8311.                 p:=GetGPWindow(data.Pipe[3]);
  8312.                 if p<>nil then p^.WMShaded
  8313.             end;
  8314.         WM_UNSHADED:
  8315.             begin
  8316.                 p:=GetGPWindow(data.Pipe[3]);
  8317.                 if p<>nil then p^.WMUnshaded
  8318.             end;
  8319.         WM_BOTTOMED,WM_M_BDROPPED:
  8320.             begin
  8321.                 p:=GetGPWindow(data.Pipe[3]);
  8322.                 if p<>nil then p^.WMBottomed
  8323.             end;
  8324.         WM_ICONIFY:
  8325.             begin
  8326.                 p:=GetGPWindow(data.Pipe[3]);
  8327.                 if p<>nil then
  8328.                     if not(p^.IsIconified) then
  8329.                         p^.WMIconify(data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7])
  8330.             end;
  8331.         WM_UNICONIFY:
  8332.             if allicn then
  8333.                 begin
  8334.                     allicn:=false;
  8335.                     ForEachWnd(@IconifyFadein);
  8336.                     dispose(icnwnd,Done);
  8337.                     Icon:=nil
  8338.                 end
  8339.             else
  8340.                 begin
  8341.                     p:=GetGPWindow(data.Pipe[3]);
  8342.                     if p<>nil then p^.WMUniconify(data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7])
  8343.                 end;
  8344.         WM_ALLICONIFY:
  8345.             begin
  8346.                 icnwnd:=new(PIcnWnd,Init(nil,StrPLeft(StrPTrimF(GetIconTitle),10),data.Pipe[4],data.Pipe[5],data.Pipe[6],data.Pipe[7]));
  8347.                 allicn:=true;
  8348.                 ForEachWnd(@IconifyFadeout)
  8349.             end;
  8350.         WM_PRINT:
  8351.             begin
  8352.                 p:=GetGPWindow(data.Pipe[3]);
  8353.                 if p<>nil then p^.Print
  8354.             end;
  8355.         WM_CUT:
  8356.             begin
  8357.                 p:=GetGPWindow(data.Pipe[3]);
  8358.                 if p<>nil then p^.Cut
  8359.             end;
  8360.         WM_COPY:
  8361.             begin
  8362.                 p:=GetGPWindow(data.Pipe[3]);
  8363.                 if p<>nil then p^.Copy
  8364.             end;
  8365.         WM_PASTE:
  8366.             begin
  8367.                 p:=GetGPWindow(data.Pipe[3]);
  8368.                 if p<>nil then p^.Paste
  8369.             end;
  8370.         WM_DELETE:
  8371.             begin
  8372.                 p:=GetGPWindow(data.Pipe[3]);
  8373.                 if p<>nil then p^.Delete
  8374.             end;
  8375.         WM_SELECTALL:
  8376.             begin
  8377.                 p:=GetGPWindow(data.Pipe[3]);
  8378.                 if p<>nil then p^.SelectAll
  8379.             end;
  8380.         AC_OPEN:
  8381.             ACOpen(data.Pipe[4]);
  8382.         AC_CLOSE:
  8383.             if MultiTOS then
  8384.                 begin
  8385.                     ret:=ACClose(data.Pipe[3],data.Pipe[5]);
  8386.                     if ret<>em_OK then shwr_ap_tfail(ret)
  8387.                     else
  8388.                         if not(CanClose) then shwr_ap_tfail(-1)
  8389.                 end
  8390.             else
  8391.                 ACClose(data.Pipe[3],AC_CLOSE);
  8392.         AP_TERM:
  8393.             begin
  8394.                 ret:=APTerm(data.Pipe[5]);
  8395.                 if ret<>em_OK then shwr_ap_tfail(ret)
  8396.                 else
  8397.                     if CanClose then Status:=em_Terminate
  8398.                     else
  8399.                         shwr_ap_tfail(-1)
  8400.             end;
  8401.         AP_DRAGDROP:
  8402.             APDragDrop(data.Pipe[7],data.Pipe[1],data.Pipe[3],data.Pipe[4],data.Pipe[5],data.Pipe[6]);
  8403.         SHUT_COMPLETED:
  8404.             ShutCompleted(data.Pipe[3],data.Pipe[4],data.Pipe[5]);
  8405.         RESCH_COMPLETED:
  8406.             ResChCompleted(data.Pipe[3]);
  8407.         CH_EXIT:
  8408.             CHExit(data.Pipe[3],data.Pipe[4]);
  8409.         SH_WDRAW:
  8410.             SHWDraw(data.Pipe[3]);
  8411.         SC_CHANGED:
  8412.             SCChanged(data.Pipe[1],word(data.Pipe[3]),StrPTrimF(chr((word(data.Pipe[4]) shr 8) and $00ff)+chr(data.Pipe[4] and $00ff)+chr((word(data.Pipe[5]) shr 8) and $00ff)+chr(data.Pipe[5] and $00ff)));
  8413.         ACC_ID:
  8414.             XAccID(data.Pipe[1],data.Pipe[6],byte(data.Pipe[3] and $00ff),byte((data.Pipe[3] and $ff00) shr 8),Ptr(word(data.Pipe[4]),word(data.Pipe[5])));
  8415.         ACC_ACC:
  8416.             if agi.MultiProto then XAccAcc(data.Pipe[1],data.Pipe[6],byte(data.Pipe[3] and $00ff),byte((data.Pipe[3] and $ff00) shr 8),Ptr(word(data.Pipe[4]),word(data.Pipe[5])))
  8417.             else
  8418.                 XAccAcc(data.Pipe[7],data.Pipe[6],byte(data.Pipe[3] and $00ff),byte((data.Pipe[3] and $ff00) shr 8),Ptr(word(data.Pipe[4]),word(data.Pipe[5])));
  8419.         ACC_EXIT:
  8420.             XAccExit(data.Pipe[1]);
  8421.         ACC_TEXT:
  8422.             xaccreply(XAccText(data.Pipe[1],Ptr(word(data.Pipe[4]),word(data.Pipe[5]))));
  8423.         ACC_KEY:
  8424.             xaccreply(XAccKey(data.Pipe[1],data.Pipe[4],data.Pipe[3]));
  8425.         ACC_META:
  8426.             xaccreply(XAccMeta(data.Pipe[1],Ptr(word(data.Pipe[4]),word(data.Pipe[5])),longint(Ptr(word(data.Pipe[6]),word(data.Pipe[7]))),data.Pipe[3]=1));
  8427.         ACC_IMG:
  8428.             xaccreply(XAccIMG(data.Pipe[1],Ptr(word(data.Pipe[4]),word(data.Pipe[5])),longint(Ptr(word(data.Pipe[6]),word(data.Pipe[7]))),data.Pipe[3]=1));
  8429.         ACC_OPEN,ACC_CLOSE,ACC_ACK:
  8430.             HandleXAcc(data.Pipe);
  8431.         AV_PROTOKOLL:
  8432.             AVProtokoll(data.Pipe[1],data.Pipe[3],StrPas(Ptr(word(data.Pipe[6]),word(data.Pipe[7]))));
  8433.         VA_PROTOSTATUS:
  8434.             VAProtoStatus(data.Pipe[1],data.Pipe[3],StrPas(Ptr(word(data.Pipe[6]),word(data.Pipe[7]))));
  8435.         AV_EXIT:
  8436.             AVExit(data.Pipe[3]);
  8437.         AV_GETSTATUS..VA_DRAG_COMPLETE:
  8438.             HandleAV(data.Pipe);
  8439.         GO_PRIVATE:
  8440.             case data.Pipe[3] of
  8441.             GOP_SETQUIT:
  8442.                 if pquit<>nil then
  8443.                     with PQKey(pquit)^ do
  8444.                         begin
  8445.                             VMNum:=data.Pipe[4];
  8446.                             VTNum:=data.Pipe[5]
  8447.                         end;
  8448.             GOP_GETVERSION:
  8449.                 goversionreply
  8450.             else
  8451.                 HandleMesag(data.Pipe)
  8452.             end
  8453.         else
  8454.             begin
  8455.                 found:=false;
  8456.                 pg:=EventList;
  8457.                 while (pg<>nil) and not(found) do
  8458.                     with pg^ do
  8459.                         begin
  8460.                             found:=TestMessage(data.Pipe);
  8461.                             pg:=Nxt
  8462.                         end;
  8463.                 if not(found) and not(allicn) then
  8464.                     begin
  8465.                         pw:=GetPTopWindow;
  8466.                         if pw<>nil then
  8467.                             begin
  8468.                                 pg:=pw^.EventList;
  8469.                                 while (pg<>nil) and not(found) do
  8470.                                     with pg^ do
  8471.                                         begin
  8472.                                             found:=TestMessage(data.Pipe);
  8473.                                             pg:=Nxt
  8474.                                         end
  8475.                             end
  8476.                     end;
  8477.                 if not(found) then HandleMesag(data.Pipe)
  8478.             end
  8479.         end;
  8480.         wind_update(END_UPDATE)
  8481.     end;
  8482.  
  8483.  
  8484. procedure TApplication.MUTimer(data: TEventData);
  8485.  
  8486.     begin
  8487.         HandleTimer
  8488.     end;
  8489.  
  8490.  
  8491. procedure TApplication.MNSelected(meNum,mtNum: integer; Tree: PTree; PrIndx: integer);
  8492.     label _fertig;
  8493.  
  8494.     var p         : PEvent;
  8495.         pw        : PWindow;
  8496.         found     : boolean;
  8497.         ted       : TEventData;
  8498.  
  8499.     begin
  8500.         if MenuTree<>nil then
  8501.             if mtNum>ROOT then menu_tnormal(MenuTree,mtNum,ME_INVERT);
  8502.         found:=false;
  8503.         p:=EventList;
  8504.         while (p<>nil) and not(found) do
  8505.             with p^ do
  8506.                 begin
  8507.                     found:=TestMenu(meNum);
  8508.                     p:=Nxt
  8509.                 end;
  8510.         if not(found) then
  8511.             if menuentries<>nil then
  8512.                 with menuentries^ do
  8513.                     begin
  8514.                         if meNum=Close.Entry then
  8515.                             begin
  8516.                                 ted.pipe[0]:=WM_CLOSED;
  8517.                                 SendWndMessage(-1,@ted.pipe,true,true);
  8518.                                 goto _fertig
  8519.                             end;
  8520.                         if meNum=Print.Entry then
  8521.                             begin
  8522.                                 ted.pipe[0]:=WM_PRINT;
  8523.                                 found:=true
  8524.                             end;
  8525.                         if meNum=Cut.Entry then
  8526.                             begin
  8527.                                 ted.pipe[0]:=WM_CUT;
  8528.                                 found:=true
  8529.                             end;
  8530.                         if meNum=Copy.Entry then
  8531.                             begin
  8532.                                 ted.pipe[0]:=WM_COPY;
  8533.                                 found:=true
  8534.                             end;
  8535.                         if meNum=Paste.Entry then
  8536.                             begin
  8537.                                 ted.pipe[0]:=WM_PASTE;
  8538.                                 found:=true
  8539.                             end;
  8540.                         if meNum=Delete.Entry then
  8541.                             begin
  8542.                                 ted.pipe[0]:=WM_DELETE;
  8543.                                 found:=true
  8544.                             end;
  8545.                         if meNum=SelectAll.Entry then
  8546.                             begin
  8547.                                 ted.pipe[0]:=WM_SELECTALL;
  8548.                                 found:=true
  8549.                             end;
  8550.                         if meNum=Full.Entry then
  8551.                             begin
  8552.                                 ted.pipe[0]:=WM_FULLED;
  8553.                                 found:=true
  8554.                             end;
  8555.                         if found then SendWndMessage(-1,@ted.pipe,true,false)
  8556.                         else
  8557.                             if meNum=Cycle.Entry then
  8558.                                 begin
  8559.                                     ted.Key:=Ctrl_Cycle;
  8560.                                     ted.KStat:=K_CTRL;
  8561.                                     MUKeybd(ted);
  8562.                                     goto _fertig
  8563.                                 end
  8564.                     end;
  8565.         if not(found) then
  8566.             begin
  8567.                 pw:=GetPTopWindow;
  8568.                 if pw<>nil then
  8569.                     if pw^.Class.MenuTree=nil then
  8570.                         begin
  8571.                             p:=pw^.EventList;
  8572.                             while (p<>nil) and not(found) do
  8573.                                 with p^ do
  8574.                                     begin
  8575.                                         found:=TestMenu(meNum);
  8576.                                         p:=Nxt
  8577.                                     end
  8578.                         end
  8579.             end;
  8580.         if not(found) then HandleMenu(meNum);
  8581.         _fertig:
  8582.         if MenuTree<>nil then
  8583.             if mtNum>ROOT then menu_tnormal(MenuTree,mtNum,ME_NORMAL)
  8584.     end;
  8585.  
  8586.  
  8587. procedure TApplication.ACOpen(mID: integer);
  8588.     var p: PWindow;
  8589.  
  8590.     begin
  8591.         if mID=menuID then
  8592.             begin
  8593.                 ChkError;
  8594.                 p:=MainWindow;
  8595.                 while (p<>nil) do
  8596.                     with p^ do
  8597.                         begin
  8598.                             if bTst(Class.Style,cs_CreateOnAccOpen) then Create;
  8599.                             OpenWindow;
  8600.                             if IsDialog then
  8601.                                 if (PDialog(p)^.IsModal) and (Err>=em_OutOfMemory) then PDialog(p)^.Execute;
  8602.                             p:=Nxt
  8603.                         end;
  8604.                 if Err<em_OutOfMemory then Error(Err)
  8605.             end
  8606.     end;
  8607.  
  8608.  
  8609. function TApplication.ACClose(mID,Why: integer): integer;
  8610.     var p   : PWindow;
  8611.         pipe: Pipearray;
  8612.  
  8613.     begin
  8614.         if mID=menuID then
  8615.             begin
  8616.                 p:=MainWindow;
  8617.                 while (p<>nil) do
  8618.                     with p^ do
  8619.                         begin
  8620.                             RawDestroy;
  8621.                             p:=Nxt;
  8622.                         end;
  8623.                 if not(agi.MultiProto) then
  8624.                     begin
  8625.                         if XAccList<>nil then dispose(PXAccCollection(XAccList),Done);
  8626.                         AVServer:=id_No;
  8627.                         XAccList:=nil;
  8628.                         pipe[0]:=ACC_ID;
  8629.                         pipe[1]:=apID;
  8630.                         pipe[2]:=0;
  8631.                         pipe[3]:=integer((XAcc.Version shl 8)+XAcc.MsgGroups);
  8632.                         pipe[4]:=integer(HiWord(xaccname));
  8633.                         pipe[5]:=integer(LoWord(xaccname));
  8634.                         pipe[6]:=menuID;
  8635.                         pipe[7]:=0;
  8636.                         appl_write(DESK,16,@pipe);
  8637.                         pipe[0]:=AV_PROTOKOLL;
  8638.                         pipe[1]:=apID;
  8639.                         pipe[2]:=0;
  8640.                         pipe[3]:=integer(XAcc.AVAccMsg);
  8641.                         pipe[4]:=0;
  8642.                         pipe[5]:=0;
  8643.                         pipe[6]:=integer((longint(apName)+1) div 65536);
  8644.                         pipe[7]:=integer((longint(apName)+1) mod 65536);
  8645.                         appl_write(DESK,16,@pipe)
  8646.                     end
  8647.             end;
  8648.         ACClose:=em_OK
  8649.     end;
  8650.  
  8651.  
  8652. function TApplication.APTerm(Why: integer): integer;
  8653.  
  8654.     begin
  8655.         APTerm:=em_OK
  8656.     end;
  8657.  
  8658.  
  8659. procedure TApplication.APDragDrop(PipeID,OrgID,WindID,mX,mY,KStat: integer);
  8660.     label _error;
  8661.  
  8662.     var ddp   : PWindow;
  8663.         oldsig: pointer;
  8664.         pname : string[19];
  8665.         res   : longint;
  8666.  
  8667.     begin
  8668.         ddokflag:=false;
  8669.         wind_update(END_UPDATE);
  8670.         ddp:=GetGPWindow(WindID);
  8671.         pname:='U:\PIPE\DRAGDROP.'+chr((PipeID and $ff00) shr 8)+chr(PipeID and $00ff);
  8672.         res:=fopen(pname,FO_RW);
  8673.         if res<0 then goto _error;
  8674.         oldsig:=Psignal(SIGPIPE,SIG_IGN);
  8675.         if ddp=nil then HandleDragDrop(integer(res),OrgID,WindID,mX,mY,KStat)
  8676.         else
  8677.             ddp^.WMDragDrop(integer(res),OrgID,mX,mY,KStat);
  8678.         if longint(oldsig)>0 then Psignal(SIGPIPE,oldsig);
  8679.         fclose(integer(res));
  8680.         _error:
  8681.         evnt_timer(20,0);
  8682.         wind_update(BEG_UPDATE);
  8683.         if ddokflag then
  8684.             begin
  8685.                 if ddp=nil then DDFinished(OrgID,WindID,mX,mY,KStat)
  8686.                 else
  8687.                     ddp^.DDFinished(OrgID,mX,mY,KStat)
  8688.             end
  8689.     end;
  8690.  
  8691.  
  8692. procedure TApplication.ShutCompleted(Stat,ErrID,ErrCode: integer);
  8693.  
  8694.     begin
  8695.     end;
  8696.  
  8697.  
  8698. procedure TApplication.ResChCompleted(Stat: integer);
  8699.  
  8700.     begin
  8701.         if Stat=1 then Status:=em_Terminate
  8702.     end;
  8703.  
  8704.  
  8705. procedure TApplication.CHExit(ChID,ChRet: integer);
  8706.  
  8707.     begin
  8708.     end;
  8709.  
  8710.  
  8711. procedure TApplication.SHWDraw(Drive: integer);
  8712.  
  8713.     begin
  8714.     end;
  8715.  
  8716.  
  8717. procedure TApplication.SCChanged(OrgID: integer; Bits: word; Ext: string);
  8718.  
  8719.     begin
  8720.     end;
  8721.  
  8722.  
  8723. procedure TApplication.XAccID(OrgID,mID: integer; Msg,Ver: byte; pName: PChar);
  8724.     var pipe: Pipearray;
  8725.         q   : integer;
  8726.  
  8727.     begin
  8728.         if agi.MultiProto then
  8729.             begin
  8730.                 XAccInsert(OrgID,mID,Msg,Ver,pName);
  8731.                 pipe[0]:=ACC_ACC;
  8732.                 pipe[1]:=apID;
  8733.                 pipe[2]:=0;
  8734.                 pipe[3]:=integer((XAcc.Version shl 8)+XAcc.MsgGroups);
  8735.                 pipe[4]:=integer(HiWord(xaccname));
  8736.                 pipe[5]:=integer(LoWord(xaccname));
  8737.                 pipe[6]:=menuID;
  8738.                 pipe[7]:=0;
  8739.                 appl_write(OrgID,16,@pipe)
  8740.             end
  8741.         else
  8742.             if AppFlag then
  8743.                 begin
  8744.                     pipe[0]:=ACC_ID;
  8745.                     pipe[1]:=apID;
  8746.                     pipe[2]:=0;
  8747.                     pipe[3]:=integer((XAcc.Version shl 8)+XAcc.MsgGroups);
  8748.                     pipe[4]:=integer(HiWord(xaccname));
  8749.                     pipe[5]:=integer(LoWord(xaccname));
  8750.                     pipe[6]:=-1;
  8751.                     pipe[7]:=0;
  8752.                     appl_write(OrgID,16,@pipe);
  8753.                     pipe[0]:=ACC_ACC;
  8754.                     pipe[3]:=integer((Ver shl 8)+Msg);
  8755.                     pipe[4]:=integer(HiWord(pName));
  8756.                     pipe[5]:=integer(LoWord(pName));
  8757.                     pipe[6]:=mID;
  8758.                     pipe[7]:=OrgID;
  8759.                     if XAccList<>nil then
  8760.                         with XAccList^ do
  8761.                             if Count>0 then
  8762.                                 for q:=0 to Count-1 do
  8763.                                     if At(q)<>nil then
  8764.                                         appl_write(PXAccAttr(At(q))^.apID,16,@pipe);
  8765.                     XAccInsert(OrgID,mID,Msg,Ver,pName)
  8766.                 end
  8767.             else
  8768.                 XAccInsert(OrgID,mID,Msg,Ver,pName)
  8769.     end;
  8770.  
  8771.  
  8772. procedure TApplication.XAccAcc(accID,mID: integer; Msg,Ver: byte; pName: PChar);
  8773.     var pipe: Pipearray;
  8774.  
  8775.     begin
  8776.         XAccInsert(accID,mID,Msg,Ver,pName);
  8777.         if not(agi.MultiProto) then
  8778.             begin
  8779.                 pipe[0]:=ACC_ID;
  8780.                 pipe[1]:=apID;
  8781.                 pipe[2]:=0;
  8782.                 pipe[3]:=integer((XAcc.Version shl 8)+XAcc.MsgGroups);
  8783.                 pipe[4]:=integer(HiWord(xaccname));
  8784.                 pipe[5]:=integer(LoWord(xaccname));
  8785.                 pipe[6]:=menuID;
  8786.                 pipe[7]:=0;
  8787.                 appl_write(accID,16,@pipe)
  8788.             end
  8789.     end;
  8790.  
  8791.  
  8792. function TApplication.XAccInsert(accID,mID: integer; Msg,Ver: byte; pName: PChar): boolean;
  8793.     var pxattr: PXAccAttr;
  8794.         xattr : TXAccAttr;
  8795.         dummy : string;
  8796.  
  8797.     begin
  8798.         XAccInsert:=false;
  8799.         if longint(pName)<=$7fff then exit;
  8800.         if FindApplication('',accID,xattr) then
  8801.             if bTst(xattr.Protocol,PROTO_XACC) then
  8802.                 begin
  8803.                     if xattr.menuID=mID then exit
  8804.                     else
  8805.                         lastfa:=-1
  8806.                 end;
  8807.         if XAccList=nil then XAccList:=new(PXAccCollection,Init(5,5));
  8808.         if XAccList=nil then exit;
  8809.         new(pxattr);
  8810.         if pxattr<>nil then
  8811.             begin
  8812.                 with pxattr^ do
  8813.                     begin
  8814.                         Version:=Ver;
  8815.                         MsgGroups:=Msg;
  8816.                         if lastfa<0 then
  8817.                             begin
  8818.                                 Protocol:=PROTO_XACC;
  8819.                                 AVSrvMsg:=0;
  8820.                                 AVAccMsg:=0
  8821.                             end
  8822.                         else
  8823.                             begin
  8824.                                 Protocol:=xattr.Protocol or PROTO_XACC;
  8825.                                 AVSrvMsg:=xattr.AVSrvMsg;
  8826.                                 AVAccMsg:=xattr.AVAccMsg
  8827.                             end;
  8828.                         apID:=accID;
  8829.                         menuID:=mID;
  8830.                         AppTypeMR:='';
  8831.                         AppTypeHR:=nil;
  8832.                         ExtFeatures:=nil;
  8833.                         GenericName:=nil;
  8834.                         pXDSC:=nil;
  8835.                         Name:=NewStr(StrPas(pName));
  8836.                         inc(longint(pName),length(Name^)+1);
  8837.                         if StrPas(pName)='XDSC' then
  8838.                             begin
  8839.                                 inc(longint(pName),5);
  8840.                                 pXDSC:=pName;
  8841.                                 dummy:=StrPas(pName);
  8842.                                 while length(dummy)>0 do
  8843.                                     begin
  8844.                                         case dummy[1] of
  8845.                                             '1': AppTypeHR:=NewStr(StrPRight(dummy,length(dummy)-1));
  8846.                                             '2': AppTypeMR:=StrPLeft(StrPRight(dummy,length(dummy)-1),2);
  8847.                                             'X': ExtFeatures:=NewStr(StrPRight(dummy,length(dummy)-1));
  8848.                                             'N': GenericName:=NewStr(StrPRight(dummy,length(dummy)-1))
  8849.                                         end;
  8850.                                         inc(longint(pName),length(dummy)+1);
  8851.                                         dummy:=StrPas(pName)
  8852.                                     end;
  8853.                                 if AppTypeHR=nil then AppTypeHR:=NewStr(XAccMR2HR(AppTypeMR))
  8854.                             end
  8855.                     end;
  8856.                 if lastfa>=0 then XAccList^.AtFree(lastfa);
  8857.                 XAccList^.Insert(pxattr);
  8858.                 XAccInsert:=true
  8859.             end
  8860.     end;
  8861.  
  8862.  
  8863. procedure TApplication.XAccExit(OrgID: integer);
  8864.     label _again;
  8865.  
  8866.     var q: longint;
  8867.  
  8868.     begin
  8869.         if XAccList<>nil then
  8870.             with XAccList^ do
  8871.                 begin
  8872.                     _again:
  8873.                     if Count>0 then
  8874.                         for q:=0 to Count-1 do
  8875.                             if At(q)<>nil then
  8876.                                 if PXAccAttr(At(q))^.apID=OrgID then
  8877.                                     begin
  8878.                                         AtFree(q);
  8879.                                         goto _again
  8880.                                     end
  8881.                 end
  8882.     end;
  8883.  
  8884.  
  8885. function TApplication.XAccText(OrgID: integer; pText: pointer): boolean;
  8886.  
  8887.     begin
  8888.         XAccText:=false
  8889.     end;
  8890.  
  8891.  
  8892. function TApplication.XAccKey(OrgID,Stat,Key: integer): boolean;
  8893.  
  8894.     begin
  8895.         XAccKey:=false
  8896.     end;
  8897.  
  8898.  
  8899. function TApplication.XAccMeta(OrgID: integer; pData: pointer; lData: longint; Final: boolean): boolean;
  8900.  
  8901.     begin
  8902.         XAccMeta:=false
  8903.     end;
  8904.  
  8905.  
  8906. function TApplication.XAccIMG(OrgID: integer; pData: pointer; lData: longint; Final: boolean): boolean;
  8907.  
  8908.     begin
  8909.         XAccIMG:=false
  8910.     end;
  8911.  
  8912.  
  8913. procedure TApplication.AVProtokoll(OrgID: integer; Msg: word; AName: string);
  8914.     var pipe: Pipearray;
  8915.  
  8916.     begin
  8917.         AVInsert(OrgID,0,Msg,AName);
  8918.         pipe[0]:=VA_PROTOSTATUS;
  8919.         pipe[1]:=apID;
  8920.         pipe[2]:=0;
  8921.         pipe[3]:=integer(XAcc.AVSrvMsg);
  8922.         pipe[4]:=0;
  8923.         pipe[5]:=0;
  8924.         pipe[6]:=integer((longint(apName)+1) div 65536);
  8925.         pipe[7]:=integer((longint(apName)+1) mod 65536);
  8926.         appl_write(OrgID,16,@pipe)
  8927.     end;
  8928.  
  8929.  
  8930. procedure TApplication.VAProtoStatus(OrgID: integer; Msg: word; AName: string);
  8931.  
  8932.     begin
  8933.         AVServer:=OrgID;
  8934.         AVInsert(OrgID,Msg,0,AName)
  8935.     end;
  8936.  
  8937.  
  8938. function TApplication.AVInsert(accID: integer; SrvMsg,AccMsg: word; AName: string): boolean;
  8939.     var pxattr: PXAccAttr;
  8940.         xattr : TXAccAttr;
  8941.  
  8942.     begin
  8943.         AVInsert:=false;
  8944.         if FindApplication('',accID,xattr) then
  8945.             if bTst(xattr.Protocol,PROTO_AV) then exit;
  8946.         if XAccList=nil then XAccList:=new(PXAccCollection,Init(5,5));
  8947.         if XAccList=nil then exit;
  8948.         new(pxattr);
  8949.         if pxattr<>nil then
  8950.             begin
  8951.                 with pxattr^ do
  8952.                     begin
  8953.                         AppTypeHR:=nil;
  8954.                         ExtFeatures:=nil;
  8955.                         GenericName:=nil;
  8956.                         AVSrvMsg:=SrvMsg;
  8957.                         AVAccMsg:=AccMsg;
  8958.                         apID:=accID;
  8959.                         if lastfa<0 then
  8960.                             begin
  8961.                                 Protocol:=PROTO_AV;
  8962.                                 Version:=0;
  8963.                                 MsgGroups:=0;
  8964.                                 menuID:=-1;
  8965.                                 AppTypeMR:='';
  8966.                                 pXDSC:=nil;
  8967.                                 Name:=NewStr(StrPTrimF(AName))
  8968.                             end
  8969.                         else
  8970.                             begin
  8971.                                 Protocol:=xattr.Protocol or PROTO_AV;
  8972.                                 Version:=xattr.Version;
  8973.                                 MsgGroups:=xattr.MsgGroups;
  8974.                                 menuID:=xattr.menuID;
  8975.                                 AppTypeMR:=xattr.AppTypeMR;
  8976.                                 if xattr.Name<>nil then Name:=NewStr(xattr.Name^)
  8977.                                 else
  8978.                                     Name:=nil;
  8979.                                 if xattr.AppTypeHR<>nil then AppTypeHR:=NewStr(xattr.AppTypeHR^);
  8980.                                 if xattr.GenericName<>nil then GenericName:=NewStr(xattr.GenericName^);
  8981.                                 if xattr.ExtFeatures<>nil then ExtFeatures:=NewStr(xattr.ExtFeatures^);
  8982.                                 pXDSC:=xattr.pXDSC
  8983.                             end
  8984.                     end;
  8985.                 if lastfa>=0 then XAccList^.AtFree(lastfa);
  8986.                 XAccList^.Insert(pxattr);
  8987.                 AVInsert:=true
  8988.             end
  8989.     end;
  8990.  
  8991.  
  8992. procedure TApplication.AVExit(OrgID: integer);
  8993.     label _again;
  8994.  
  8995.     var q: longint;
  8996.  
  8997.     begin
  8998.         if XAccList<>nil then
  8999.             with XAccList^ do
  9000.                 begin
  9001.                     _again:
  9002.                     if Count>0 then
  9003.                         for q:=0 to Count-1 do
  9004.                             if At(q)<>nil then
  9005.                                 with PXAccAttr(At(q))^ do
  9006.                                     if apID=OrgID then
  9007.                                         if bTst(Protocol,PROTO_AV) then
  9008.                                             begin
  9009.                                                 if apID=AVServer then AVServer:=id_No;
  9010.                                                 Protocol:=Protocol and not(PROTO_AV);
  9011.                                                 if Protocol=0 then AtFree(q)
  9012.                                                 else
  9013.                                                     begin
  9014.                                                         AVSrvMsg:=0;
  9015.                                                         AVAccMsg:=0
  9016.                                                     end;
  9017.                                                 goto _again
  9018.                                             end
  9019.                 end
  9020.     end;
  9021.  
  9022.  
  9023. function TApplication.DDGetPreferredTypes(WindID: integer): string;
  9024.  
  9025.     begin
  9026.         DDGetPreferredTypes:=''
  9027.     end;
  9028.  
  9029.  
  9030. function TApplication.DDGetPath(WindID: integer): string;
  9031.  
  9032.     begin
  9033.         DDGetPath:=''
  9034.     end;
  9035.  
  9036.  
  9037. function TApplication.DDHeaderReply(dType,dName,fName: string; dSize: longint; OrgID,WindID,mX,mY,KStat: integer): byte;
  9038.  
  9039.     begin
  9040.         DDHeaderReply:=DD_NAK
  9041.     end;
  9042.  
  9043.  
  9044. function TApplication.DDReadData(dType,dName,fName: string; dSize: longint; PipeHnd,OrgID,WindID,mX,mY,KStat: integer): boolean;
  9045.  
  9046.     begin
  9047.         DDReadData:=false
  9048.     end;
  9049.  
  9050.  
  9051. function TApplication.DDReadArgs(dSize: longint; PipeHnd,OrgID,WindID,mX,mY,KStat: integer): boolean;
  9052.     var buffer: array [0..127] of byte;
  9053.  
  9054.     begin
  9055.         DDReadArgs:=false;
  9056.         if dSize<=0 then exit;
  9057.         while dSize>128 do
  9058.             begin
  9059.                 if fread(PipeHnd,128,@buffer)<>128 then exit;
  9060.                 dec(dSize,128)
  9061.             end;
  9062.         fread(PipeHnd,dSize,@buffer)
  9063.     end;
  9064.  
  9065.  
  9066. procedure TApplication.DDFinished(OrgID,WindID,mX,mY,KStat: integer);
  9067.  
  9068.     begin
  9069.     end;
  9070.  
  9071.  
  9072. procedure TApplication.Cut;
  9073.  
  9074.     begin
  9075.     end;
  9076.  
  9077.  
  9078. procedure TApplication.Copy;
  9079.  
  9080.     begin
  9081.     end;
  9082.  
  9083.  
  9084. procedure TApplication.Paste;
  9085.  
  9086.     begin
  9087.     end;
  9088.  
  9089.  
  9090. procedure TApplication.Delete;
  9091.  
  9092.     begin
  9093.     end;
  9094.  
  9095.  
  9096. procedure TApplication.SelectAll;
  9097.  
  9098.     begin
  9099.         IconSelect(true,id_No)
  9100.     end;
  9101.  
  9102.  
  9103. procedure TApplication.HandleDragDrop(PipeHnd,OrgID,WindID,mX,mY,KStat: integer);
  9104.     label _readhdr,_prefext;
  9105.  
  9106.     var answer           : string;
  9107.         hdrlen,i         : integer;
  9108.         dtype            : string[4];
  9109.         dsize            : longint;
  9110.         dname,ndata,nfile: string[DD_NAMEMAX];
  9111.  
  9112.     begin
  9113.         answer:=chr(DD_OK);
  9114.         if fwrite(PipeHnd,1,@answer[1])<>1 then exit;
  9115.         _prefext:
  9116.         answer:=StrPLeft(DDGetPreferredTypes(WindID),DD_EXTSIZE);
  9117.         while length(answer)<DD_EXTSIZE do answer:=answer+#0;
  9118.         if fwrite(PipeHnd,DD_EXTSIZE,@answer[1])<>DD_EXTSIZE then exit;
  9119.         _readhdr:
  9120.         if fread(PipeHnd,2,@hdrlen)<>2 then exit;
  9121.         if hdrlen<9 then exit;
  9122.         dtype:='    ';
  9123.         if fread(PipeHnd,4,@dtype[1])<>4 then exit;
  9124.         if fread(PipeHnd,4,@dsize)<>4 then exit;
  9125.         dec(hdrlen,8);
  9126.         if hdrlen>DD_NAMEMAX then i:=DD_NAMEMAX
  9127.         else
  9128.             i:=hdrlen;
  9129.         fillchar(dname,sizeof(dname),0);
  9130.         if fread(PipeHnd,i,@dname[1])<>i then exit;
  9131.         dec(hdrlen,i);
  9132.         ndata:='';
  9133.         nfile:='';
  9134.         i:=1;
  9135.         while dname[i]<>#0 do
  9136.             begin
  9137.                 ndata:=ndata+dname[i];
  9138.                 inc(i)
  9139.             end;
  9140.         inc(i);
  9141.         while dname[i]<>#0 do
  9142.             begin
  9143.                 nfile:=nfile+dname[i];
  9144.                 inc(i)
  9145.             end;
  9146.         while hdrlen>DD_NAMEMAX+1 do
  9147.             begin
  9148.                 if fread(PipeHnd,DD_NAMEMAX+1,@dname)<>DD_NAMEMAX+1 then exit;
  9149.                 dec(hdrlen,DD_NAMEMAX+1)
  9150.             end;
  9151.         if hdrlen>0 then
  9152.             if fread(PipeHnd,hdrlen,@dname)<>hdrlen then exit;
  9153.         if dtype='PATH' then
  9154.             begin
  9155.                 answer:=StrPTrimF(DDGetPath(WindID));
  9156.                 if length(answer)=0 then answer:=chr(DD_NAK)
  9157.                 else
  9158.                     answer:=StrPLeft(chr(DD_OK)+answer,dsize);
  9159.                 fwrite(PipeHnd,length(answer),@answer[1]);
  9160.                 exit
  9161.             end;
  9162.         if dtype='ARGS' then
  9163.             begin
  9164.                 answer:=chr(DD_OK);
  9165.                 if fwrite(PipeHnd,1,@answer[1])<>1 then exit;
  9166.                 if dsize>0 then
  9167.                     if DDReadArgs(dsize,PipeHnd,OrgID,WindID,mX,mY,KStat) then ddokflag:=true;
  9168.                 exit
  9169.             end;
  9170.         answer:=chr(DDHeaderReply(dtype,ndata,nfile,dsize,OrgID,WindID,mX,mY,KStat));
  9171.         if fwrite(PipeHnd,1,@answer[1])<>1 then exit;
  9172.         case ord(answer[1]) of
  9173.             DD_OK:  if DDReadData(dtype,ndata,nfile,dsize,PipeHnd,OrgID,WindID,mX,mY,KStat) then ddokflag:=true;
  9174.             DD_EXT: goto _readhdr;
  9175.             DD_LEN: goto _prefext
  9176.         end
  9177.     end;
  9178.  
  9179.  
  9180. procedure TApplication.HandleKeybd(Stat,Key: integer);
  9181.   var pw         : PWindow;
  9182.       mx,my,dummy: integer;
  9183.  
  9184.     begin
  9185.         if bTst(Attr.Style,as_XInputMode) then
  9186.             begin
  9187.                 graf_mkstate(mx,my,dummy,dummy);
  9188.                 pw:=GetGPWindow(wind_find(mx,my));
  9189.                 if pw=nil then pw:=GetPTopWindow
  9190.             end
  9191.         else
  9192.             pw:=GetPTopWindow;
  9193.         if pw<>nil then pw^.WMKeyDown(Stat,Key)
  9194.     end;
  9195.  
  9196.  
  9197. procedure TApplication.HandleButton(mX,mY,BStat,KStat,Clicks: integer);
  9198.  
  9199.     begin
  9200.         if BStat<>1 then exit;
  9201.         if (KStat and K_SHIFT)>0 then IconSelect(false,DESK)
  9202.         else
  9203.             IconSelect(false,id_No)
  9204.     end;
  9205.  
  9206.  
  9207. procedure TApplication.HandleM1(mX,mY,BStat,KStat: integer);
  9208.     var cursor: HCursor;
  9209.  
  9210.     begin
  9211.         if pcrswatch<>nil then
  9212.             if not(IsMouseBusy) then
  9213.                 begin
  9214.                     wind_update(BEG_UPDATE);
  9215.                     Attr.EventMask:=(Attr.EventMask and not(MU_M1)) or MU_M2;
  9216.                     wmnr:=GP.mnr;
  9217.                     wmform:=GP.mform;
  9218.                     if pcrswatch^.IsIconified then cursor:=pcrswatch^.IconClass.hCursor
  9219.                     else
  9220.                         cursor:=pcrswatch^.Class.hCursor;
  9221.                     if cursor>$7fff then graf_mouse(USER_DEF,pointer(cursor))
  9222.                     else
  9223.                         graf_mouse(cursor,nil);
  9224.                     wind_update(END_UPDATE)
  9225.                 end
  9226.     end;
  9227.  
  9228.  
  9229. procedure TApplication.HandleM2(mX,mY,BStat,KStat: integer);
  9230.  
  9231.     begin
  9232.         if pcrswatch<>nil then
  9233.             begin
  9234.                 wind_update(BEG_UPDATE);
  9235.                 Attr.EventMask:=(Attr.EventMask and not(MU_M2)) or MU_M1;
  9236.                 if not(IsMouseBusy) then graf_mouse(wmnr,@wmform);
  9237.                 wind_update(END_UPDATE)
  9238.             end
  9239.     end;
  9240.  
  9241.  
  9242. procedure TApplication.HandleMesag(Pipe: Pipearray);
  9243.  
  9244.     begin
  9245.     end;
  9246.  
  9247.  
  9248. procedure TApplication.HandleAV(Pipe: Pipearray);
  9249.  
  9250.     begin
  9251.     end;
  9252.  
  9253.  
  9254. procedure TApplication.HandleXAcc(Pipe: Pipearray);
  9255.  
  9256.     begin
  9257.     end;
  9258.  
  9259.  
  9260. procedure TApplication.HandleTimer;
  9261.  
  9262.     begin
  9263.     end;
  9264.  
  9265.  
  9266. procedure TApplication.HandleMenu(meNum: integer);
  9267.  
  9268.     begin
  9269.     end;
  9270.  
  9271.  
  9272. procedure TApplication.HandleError;
  9273.  
  9274.     begin
  9275.         if Status=em_OutOfMemory then Status:=em_OK
  9276.     end;
  9277.  
  9278.  
  9279. procedure TApplication.Terminate;
  9280.  
  9281.     begin
  9282.     end;
  9283.  
  9284.  
  9285. procedure TApplication.Run;
  9286.  
  9287.   begin
  9288.     if AppFlag then ArrowMouse;
  9289.     if Status>=em_OK then
  9290.         begin
  9291.             termflag:=true;
  9292.             MessageLoop
  9293.             end
  9294.   end;
  9295.  
  9296.  
  9297. procedure TApplication.Quit;
  9298.  
  9299.     begin
  9300.         Status:=em_Quit
  9301.     end;
  9302.  
  9303.  
  9304. function TApplication.At(Index: integer): PWindow;
  9305.     var len: integer;
  9306.         p  : PWindow;
  9307.  
  9308.     begin
  9309.         len:=0;
  9310.         p:=MainWindow;
  9311.         while p<>nil do
  9312.             begin
  9313.                 inc(len);
  9314.                 p:=p^.Nxt
  9315.             end;
  9316.         At:=nil;
  9317.         if (Index<0) or (len=0) then exit;
  9318.         Index:=Index mod len;
  9319.         p:=MainWindow;
  9320.         if Index>0 then
  9321.             for len:=0 to Index-1 do p:=p^.Nxt;
  9322.         At:=p
  9323.     end;
  9324.  
  9325.  
  9326. function TApplication.IndexOf(Item: PWindow): integer;
  9327.     var count: integer;
  9328.         p    : PWindow;
  9329.  
  9330.     begin
  9331.         IndexOf:=-1;
  9332.         count:=0;
  9333.         p:=MainWindow;
  9334.         while p<>nil do
  9335.             begin
  9336.                 if p=Item then
  9337.                     begin
  9338.                         IndexOf:=count;
  9339.                         exit
  9340.                     end;
  9341.                 inc(count);
  9342.                 p:=p^.Nxt
  9343.             end
  9344.     end;
  9345.  
  9346.  
  9347. function TApplication.FirstWndThat(Test: PIterationFunc): PWindow;
  9348.     var p,pc: PWindow;
  9349.         cl  : IterationFunc;
  9350.  
  9351.     begin
  9352.         FirstWndThat:=nil;
  9353.         p:=MainWindow;
  9354.         cl:=IterationFunc(Test);
  9355.         while p<>nil do
  9356.             begin
  9357.                 if cl(p) then
  9358.                     begin
  9359.                         FirstWndThat:=p;
  9360.                         exit
  9361.                     end;
  9362.                 pc:=p^.FirstWndThat(Test);
  9363.                 if pc<>nil then
  9364.                     begin
  9365.                         FirstWndThat:=pc;
  9366.                         exit
  9367.                     end;
  9368.                 p:=p^.Nxt
  9369.             end;
  9370.     end;
  9371.  
  9372.  
  9373. procedure TApplication.ForEachWnd(Action: PIterationProc);
  9374.     var p : PWindow;
  9375.         cl: IterationProc;
  9376.  
  9377.     begin
  9378.         p:=MainWindow;
  9379.         cl:=IterationProc(Action);
  9380.         while p<>nil do
  9381.             begin
  9382.                 cl(p);
  9383.                 p^.ForEachWnd(Action);
  9384.                 p:=p^.Nxt
  9385.             end
  9386.     end;
  9387.  
  9388.  
  9389. function TApplication.FirstIcon(OnAll: boolean): PIcon;
  9390.  
  9391.     begin
  9392.         icnonall:=OnAll;
  9393.         nxticn:=EventList;
  9394.         FirstIcon:=NextIcon
  9395.     end;
  9396.  
  9397.  
  9398. function TApplication.NextIcon: PIcon;
  9399.     label _weiter;
  9400.  
  9401.     begin
  9402.         NextIcon:=nil;
  9403.         while nxticn<>nil do
  9404.             begin
  9405.                 if bTst(nxticn^.Style,es_Icon) then
  9406.                     begin
  9407.                         if icnonall then
  9408.                             if PIcon(nxticn)^.GetCheck<>bf_Checked then goto _weiter;
  9409.                         NextIcon:=PIcon(nxticn);
  9410.                         nxticn:=nxticn^.Next;
  9411.                         exit
  9412.                     end;
  9413.                 _weiter:
  9414.                 nxticn:=nxticn^.Next
  9415.             end
  9416.     end;
  9417.  
  9418.  
  9419. procedure TApplication.IconSelect(OnOff: boolean; OffExc: integer);
  9420.     var pe: PEvent;
  9421.         pw: PWindow;
  9422.  
  9423.     begin
  9424.         pe:=EventList;
  9425.         if OnOff then
  9426.             while pe<>nil do
  9427.                 begin
  9428.                     if bTst(pe^.Style,es_Icon) then PIcon(pe)^.Check;
  9429.                     pe:=pe^.Next
  9430.                 end
  9431.         else
  9432.             begin
  9433.                 if OffExc<>DESK then
  9434.                     while pe<>nil do
  9435.                         begin
  9436.                             if bTst(pe^.Style,es_Icon) then PIcon(pe)^.Uncheck;
  9437.                             pe:=pe^.Next
  9438.                         end;
  9439.                 pw:=MainWindow;
  9440.                 while pw<>nil do
  9441.                     begin
  9442.                         pw^.IconSelect(false,OffExc);
  9443.                         pw:=pw^.Next
  9444.                     end
  9445.             end
  9446.     end;
  9447.  
  9448.  
  9449. procedure TApplication.IconPaint(Work: GRECT; var PaintInfo: TPaintStruct);
  9450.  
  9451.     begin
  9452.     end;
  9453.  
  9454.  
  9455. procedure TApplication.BubbleHelp(mX,mY: integer; Delay: word; Hlp: string);
  9456.     label _memfail;
  9457.  
  9458.     var pxy                 : ARRAY_4;
  9459.         bpxy                : record
  9460.                                 case integer of
  9461.                                   0: (b8     : ARRAY_8);
  9462.                                   1: (b41,b42: ARRAY_4)
  9463.                               end;
  9464.         scrn,backgr         : MFDB;
  9465.         dummy,cw,loffs,lanz : integer;
  9466.         xpos,ypos,xc,yc,mlen: integer;
  9467.         blen,ql             : longint;
  9468.         pipe                : Pipearray;
  9469.         qp                  : pointer;
  9470.         qused               : boolean;
  9471.  
  9472.     begin
  9473.         if length(Hlp)=0 then exit;
  9474.         wind_update(BEG_UPDATE);
  9475.         wind_update(BEG_MCTRL);
  9476.         InitVWrk;
  9477.         HideMouse;
  9478.         pxy[0]:=0;
  9479.         pxy[1]:=0;
  9480.         pxy[2]:=Attr.MaxPX;
  9481.         pxy[3]:=Attr.MaxPY;
  9482.         vs_clip(vdiHandle,CLIP_ON,pxy);
  9483.         gem.vst_alignment(vdiHandle,TA_LEFT,TA_TOP,dummy,dummy);
  9484.         gem.vst_height(vdiHandle,SysInfo.SFHeight,dummy,dummy,cw,loffs);
  9485.         Hlp:=AlertBubbleWrap(Hlp,Min(37,(Attr.MaxPX div cw)-2));
  9486.         lanz:=1;
  9487.         mlen:=0;
  9488.         xpos:=1;
  9489.         for dummy:=1 to length(Hlp) do
  9490.             if Hlp[dummy]='|' then
  9491.                 begin
  9492.                     if dummy-xpos>mlen then mlen:=dummy-xpos;
  9493.                     xpos:=dummy+1;
  9494.                     inc(lanz)
  9495.                 end;
  9496.         if length(Hlp)+1-xpos>mlen then mlen:=length(Hlp)+1-xpos;
  9497.         xpos:=mX-((mlen*cw) shr 2);
  9498.         ypos:=mY-(lanz+2)*loffs;
  9499.         if xpos+(mlen+1)*cw>Attr.MaxPX then xpos:=Attr.MaxPX-(mlen+1)*cw;
  9500.         if ypos<=(loffs shr 1) then
  9501.             begin
  9502.                 ypos:=(loffs shr 1)+1;
  9503.                 if ypos+(lanz+2)*loffs>mY then
  9504.                     begin
  9505.                         ypos:=mY+((loffs*3) shr 1);
  9506.                         xpos:=mX-((mlen*cw) shr 2)*3
  9507.                     end
  9508.             end;
  9509.         if xpos<=cw then xpos:=cw+1;
  9510.         pxy[0]:=xpos-cw;
  9511.         pxy[1]:=ypos-(loffs shr 1);
  9512.         pxy[2]:=pxy[0]+(mlen+2)*cw;
  9513.         pxy[3]:=pxy[1]+(lanz+1)*loffs;
  9514.         xc:=xpos+((mlen*cw) shr 1);
  9515.         bpxy.b8[0]:=pxy[0]-2;
  9516.         bpxy.b8[2]:=pxy[2]+1;
  9517.         if pxy[1]<mY then
  9518.             begin
  9519.                 yc:=pxy[3];
  9520.                 bpxy.b8[1]:=pxy[1]-2;
  9521.                 bpxy.b8[3]:=mY+4
  9522.             end
  9523.         else
  9524.             begin
  9525.                 yc:=pxy[1];
  9526.                 bpxy.b8[1]:=mY-4;
  9527.                 bpxy.b8[3]:=pxy[3]+1
  9528.             end;
  9529.         if bpxy.b8[0]<0 then bpxy.b8[0]:=0;
  9530.         if bpxy.b8[1]<0 then bpxy.b8[1]:=0;
  9531.         if bpxy.b8[2]>Attr.MaxPX then bpxy.b8[2]:=Attr.MaxPX;
  9532.         if bpxy.b8[3]>Attr.MaxPY then bpxy.b8[3]:=Attr.MaxPY;
  9533.         with backgr do
  9534.             begin
  9535.                 fd_w:=bpxy.b8[2]+1-bpxy.b8[0];
  9536.                 fd_h:=bpxy.b8[3]+1-bpxy.b8[1];
  9537.                 fd_stand:=FF_DEVSPEC;
  9538.                 fd_wdwidth:=(fd_w+15) shr 4;
  9539.                 fd_nplanes:=Attr.Planes;
  9540.                 blen:=(longint(fd_wdwidth)*longint(fd_h)*longint(fd_nplanes)) shl 1
  9541.             end;
  9542.         if IsQSBUsed then ql:=-1
  9543.         else
  9544.             GetQSB(qp,ql);
  9545.         qused:=(ql>=blen);
  9546.         if qused then
  9547.             begin
  9548.                 backgr.fd_addr:=qp;
  9549.                 IsQSBUsed:=true
  9550.             end
  9551.         else
  9552.             getmem(backgr.fd_addr,blen);
  9553.         if backgr.fd_addr=nil then goto _memfail;
  9554.         scrn.fd_addr:=nil;
  9555.         bpxy.b8[4]:=0;
  9556.         bpxy.b8[5]:=0;
  9557.         bpxy.b8[6]:=backgr.fd_w-1;
  9558.         bpxy.b8[7]:=backgr.fd_h-1;
  9559.         vro_cpyfm(vdiHandle,S_ONLY,bpxy.b8,scrn,backgr);
  9560.         gem.vsf_interior(vdiHandle,FIS_SOLID);
  9561.         v_rfbox(vdiHandle,pxy);
  9562.         for dummy:=0 to 3 do dec(pxy[dummy]);
  9563.         gem.vsf_interior(vdiHandle,FIS_HOLLOW);
  9564.         v_rfbox(vdiHandle,pxy);
  9565.         dummy:=round(sqrt(sqr(mX-xc)+sqr(mY-yc))/6);
  9566.         pxya[0]:=xc-dummy;
  9567.         pxya[1]:=yc-1;
  9568.         pxya[2]:=xc+dummy;
  9569.         pxya[3]:=pxya[1];
  9570.         pxya[4]:=mX;
  9571.         pxya[5]:=mY;
  9572.         pxya[6]:=pxya[0];
  9573.         pxya[7]:=pxya[1];
  9574.         v_fillarea(vdiHandle,4,pxya);
  9575.         inc(pxya[0]);
  9576.         dec(pxya[2]);
  9577.         gem.vsl_color(vdiHandle,White);
  9578.         v_pline(vdiHandle,2,pxya);
  9579.         gem.vsl_color(vdiHandle,Black);
  9580.         pxya[4]:=pxya[2];
  9581.         pxya[5]:=pxya[3];
  9582.         pxya[2]:=mX;
  9583.         pxya[3]:=mY;
  9584.         v_pline(vdiHandle,3,pxya);
  9585.         dummy:=pos('|',Hlp);
  9586.         while dummy>0 do
  9587.             begin
  9588.                 v_gtext(vdiHandle,xpos,ypos,StrPLeft(Hlp,dummy-1));
  9589.                 Hlp:=StrPRight(Hlp,length(Hlp)-dummy);
  9590.                 inc(ypos,loffs);
  9591.                 dummy:=pos('|',Hlp)
  9592.             end;
  9593.         v_gtext(vdiHandle,xpos,ypos,Hlp);
  9594.         ShowMouse;
  9595.         graf_mouse(MFORCE or IDC_HELP,pointer(1));
  9596.         repeat
  9597.             graf_mkstate(dummy,dummy,cw,dummy)
  9598.         until cw=0;
  9599.         evnt_timer(Delay,0);
  9600.         evnt_multi(MU_KEYBD or MU_BUTTON or MU_M1,257,3,0,1,mX-8,mY-8,17,17,0,0,0,0,0,pipe,0,0,dummy,dummy,dummy,dummy,dummy,dummy);
  9601.         HideMouse;
  9602.         scrn.fd_addr:=nil;
  9603.         pxy:=bpxy.b41;
  9604.         bpxy.b41:=bpxy.b42;
  9605.         bpxy.b42:=pxy;
  9606.         vro_cpyfm(vdiHandle,S_ONLY,bpxy.b8,backgr,scrn);
  9607.         if qused then IsQSBUsed:=false
  9608.         else
  9609.             freemem(backgr.fd_addr,blen);
  9610.         _memfail:
  9611.         RestoreVWrk;
  9612.         ShowMouse;
  9613.         gem.graf_mouse(GP.mnr,@GP.mform);
  9614.         repeat
  9615.             graf_mkstate(dummy,dummy,cw,dummy)
  9616.         until not(bTst(cw,2));
  9617.         wind_update(END_MCTRL);
  9618.         wind_update(END_UPDATE)
  9619.     end;
  9620.  
  9621.  
  9622. function TApplication.ExecDialog(ADialog: PDialog): integer;
  9623.  
  9624.     begin
  9625.         if ADialog=nil then ExecDialog:=em_InvalidDialog
  9626.         else
  9627.             begin
  9628.                 with ADialog^ do
  9629.                     begin
  9630.                         Attr.ExStyle:=(Attr.ExStyle and not(ws_ex_TryModeless)) or ws_ex_Center2Parent;
  9631.                         Result:=em_InvalidDialog;
  9632.                         MakeWindow;
  9633.                         ExecDialog:=Result
  9634.                     end;
  9635.                 ADialog^.Free
  9636.             end
  9637.     end;
  9638.  
  9639.  
  9640. function TApplication.Alert(AParent: PWindow; DefBtn: integer; Sign: longint; Txt,Btn: string): integer;
  9641.     const alertref: array [0..3] of AESOBJECT =
  9642.                     ((ob_next:-1;ob_head:1;ob_tail:4;ob_type:G_BOX;ob_flags:NONE;ob_state:OUTLINED;ob_spec:(index:$11100);ob_x:2;ob_y:1;ob_width:38;ob_height:6),
  9643.                      (ob_next:3;ob_head:-1;ob_tail:-1;ob_type:G_BUTTON;ob_flags:SELECTABLE or F_EXIT;ob_state:NORMAL;ob_spec:(free_string:nil);ob_x:27;ob_y:4;ob_width:9;ob_height:1),
  9644.                      (ob_next:4;ob_head:-1;ob_tail:-1;ob_type:G_STRING;ob_flags:NONE;ob_state:NORMAL;ob_spec:(free_string:nil);ob_x:27;ob_y:1;ob_width:6;ob_height:1),
  9645.                      (ob_next:0;ob_head:-1;ob_tail:-1;ob_type:G_IMAGE;ob_flags:NONE;ob_state:NORMAL;ob_spec:(bit_blk:nil);ob_x:2;ob_y:1;ob_width:4;ob_height:2));
  9646.  
  9647.                 highres: array [1..3,0..63] of word =
  9648.                                 (($0003,$c000,$0006,$6000,$000d,$b000,$001b,$d800,$0037,$ec00,
  9649.                                     $006f,$f600,$00dc,$3b00,$01bc,$3d80,$037c,$3ec0,$06fc,$3f60,
  9650.                                     $0dfc,$3fb0,$1bfc,$3fd8,$37fc,$3fec,$6ffc,$3ff6,$dffc,$3ffb,
  9651.                                     $bffc,$3ffd,$bffc,$3ffd,$dffc,$3ffb,$6ffc,$3ff6,$37fc,$3fec,
  9652.                                     $1bff,$ffd8,$0dff,$ffb0,$06fc,$3f60,$037c,$3ec0,$01bc,$3d80,
  9653.                                     $00dc,$3b00,$006f,$f600,$0037,$ec00,$001b,$d800,$000d,$b000,
  9654.                                     $0006,$6000,$0003,$c000),
  9655.                                  ($3fff,$fffc,$c000,$0003,$9fff,$fff9,$bfff,$fffd,$dff8,$3ffb,
  9656.                                     $5fe0,$0ffa,$6fc0,$07f6,$2f83,$83f4,$3787,$c3ec,$1787,$c3e8,
  9657.                                     $1bff,$83d8,$0bff,$07d0,$0dfe,$0fb0,$05fc,$1fa0,$06fc,$3f60,
  9658.                                     $02fc,$3f40,$037c,$3ec0,$017c,$3e80,$01bf,$fd80,$00bf,$fd00,
  9659.                                     $00dc,$3b00,$005c,$3a00,$006c,$3600,$002f,$f400,$0037,$ec00,
  9660.                                     $0017,$e800,$001b,$d800,$000b,$d000,$000d,$b000,$0005,$a000,
  9661.                                     $0006,$6000,$0003,$c000),
  9662.                                  ($007f,$fe00,$00c0,$0300,$01bf,$fd80,$037f,$fec0,$06ff,$ff60,
  9663.                                     $0dff,$ffb0,$1bff,$ffd8,$37ff,$ffec,$6fff,$fff6,$dfff,$fffb,
  9664.                                     $b181,$860d,$a081,$0205,$a4e7,$3265,$a7e7,$3265,$a3e7,$3265,
  9665.                                     $b1e7,$3205,$b8e7,$320d,$bce7,$327d,$a4e7,$327d,$a0e7,$027d,
  9666.                                     $b1e7,$867d,$bfff,$fffd,$dfff,$fffb,$6fff,$fff6,$37ff,$ffec,
  9667.                                     $1bff,$ffd8,$0dff,$ffb0,$06ff,$ff60,$037f,$fec0,$01bf,$fd80,
  9668.                                     $00c0,$0300,$007f,$fe00));
  9669.  
  9670.                 ABACKBOX      = 0;
  9671.                 ABUTTON       = 1;
  9672.                 ASTRING       = 2;
  9673.                 ABITBLOCK     = 3;
  9674.                 ALRT_MAXLINES = 18;
  9675.                 ALRT_MAXBTN   = 12;
  9676.                 ALRT_WBORDER  =  2;
  9677.                 ALRT_HBORDER  =  1;
  9678.                 ALRT_WBINNER  =  1;
  9679.                 ALRT_WBITBLK  =  4;
  9680.                 ALRT_HBITBLK  =  2;
  9681.                 ALRT_HBUTTON  =  1;
  9682.                 ALRT_HTEXT    =  1;
  9683.  
  9684.     var cnttext,cntbutton,objused    : integer;
  9685.         firstbutton,maxbutton,maxtext: integer;
  9686.         firsttext,obj,i,treecnt      : integer;
  9687.         tree                         : PTree;
  9688.         adlg                         : PDialog;
  9689.         pbitblk                      : pointer;
  9690.         bbcalc                       : BITBLK;
  9691.         smfdb                        : MFDB;
  9692.         ltmval                       : longint;
  9693.  
  9694.     procedure filterzero(var s: string);
  9695.         var ps: integer;
  9696.  
  9697.         begin
  9698.             ps:=pos(#0,s);
  9699.             while ps>0 do
  9700.                 begin
  9701.                     s:=StrPLeft(s,ps-1)+StrPRight(s,length(s)-ps);
  9702.                     ps:=pos(#0,s)
  9703.                 end
  9704.         end;
  9705.  
  9706.     function counttokens(var s: string; manz: integer): integer;
  9707.         var ret,c: integer;
  9708.  
  9709.         begin
  9710.             ret:=1;
  9711.             for c:=1 to length(s) do
  9712.                 begin
  9713.                     if s[c]='|' then inc(ret);
  9714.                     if ret>manz then
  9715.                         begin
  9716.                             s:=StrPLeft(s,c-1);
  9717.                             dec(ret);
  9718.                             break
  9719.                         end
  9720.                 end;
  9721.             counttokens:=ret
  9722.         end;
  9723.  
  9724.     procedure createalert;
  9725.         var dummy,c         : string;
  9726.             i,max1,max2,xpos: integer;
  9727.  
  9728.         function taketoken: string;
  9729.             var q,l: integer;
  9730.                 tt : string;
  9731.  
  9732.             begin
  9733.                 taketoken:='';
  9734.                 l:=length(dummy);
  9735.                 if l=0 then exit;
  9736.                 q:=1;
  9737.                 while (dummy[q]<>'|') and (q<l) do inc(q);
  9738.                 if dummy[q]='|' then
  9739.                     begin
  9740.                         tt:=StrPLeft(dummy,q-1);
  9741.                         if length(tt)=0 then taketoken:=' ' else taketoken:=tt;
  9742.                         dummy:=StrPRight(dummy,length(dummy)-q);
  9743.                         if length(dummy)=0 then dummy:=' '
  9744.                     end
  9745.                 else
  9746.                     begin
  9747.                         taketoken:=dummy;
  9748.                         dummy:=''
  9749.                     end
  9750.             end;
  9751.  
  9752.         begin
  9753.             tree^[ROOT]:=alertref[ABACKBOX];
  9754.             treecnt:=1;
  9755.             if pbitblk<>nil then
  9756.                 begin
  9757.                     tree^[treecnt]:=alertref[ABITBLOCK];
  9758.                     tree^[treecnt].ob_spec.bit_blk:=pbitblk;
  9759.                     inc(treecnt)
  9760.                 end;
  9761.             obj:=treecnt;
  9762.             firsttext:=treecnt;
  9763.             for i:=0 to cnttext-1 do
  9764.                 begin
  9765.                     tree^[treecnt]:=alertref[ASTRING];
  9766.                     inc(treecnt)
  9767.                 end;
  9768.             maxtext:=0;
  9769.             dummy:=Txt;
  9770.             c:=taketoken;
  9771.             while length(c)>0 do
  9772.                 begin
  9773.                     if maxtext<length(c) then maxtext:=length(c);
  9774.                     tree^[obj].ob_spec.free_string:=ChrNew(c);
  9775.                     inc(obj);
  9776.                     c:=taketoken
  9777.                 end;
  9778.             obj:=treecnt;
  9779.             firstbutton:=treecnt;
  9780.             for i:=0 to cntbutton-1 do
  9781.                 begin
  9782.                     tree^[treecnt]:=alertref[ABUTTON];
  9783.                     inc(treecnt)
  9784.                 end;
  9785.             if (DefBtn>=1) and (DefBtn<=cntButton) then
  9786.                 tree^[obj+DefBtn-1].ob_flags:=tree^[obj+DefBtn-1].ob_flags or DEFAULT;
  9787.             maxbutton:=0;
  9788.             dummy:=Btn;
  9789.             c:=taketoken;
  9790.             while length(c)>0 do
  9791.                 begin
  9792.                     if pos('&',c)>0 then
  9793.                         begin
  9794.                             if maxbutton<length(c)-1 then maxbutton:=length(c)-1
  9795.                         end
  9796.                     else
  9797.                         if maxbutton<length(c) then maxbutton:=length(c);
  9798.                     tree^[obj].ob_spec.free_string:=ChrNew(c);
  9799.                     inc(obj);
  9800.                     c:=taketoken
  9801.                 end;
  9802.             inc(maxbutton);
  9803.             tree^[ROOT].ob_next:=-1;
  9804.             tree^[ROOT].ob_head:=1;
  9805.             tree^[ROOT].ob_tail:=treecnt-1;
  9806.             for i:=1 to treecnt-1 do
  9807.                 begin
  9808.                     tree^[i].ob_next:=i+1;
  9809.                     tree^[i].ob_head:=-1;
  9810.                     tree^[i].ob_tail:=-1
  9811.                 end;
  9812.             tree^[treecnt-1].ob_flags:=tree^[treecnt-1].ob_flags or LASTOB;
  9813.             tree^[treecnt-1].ob_next:=ROOT;
  9814.             max1:=ALRT_WBORDER+maxtext;
  9815.             if pbitblk<>nil then inc(max1,ALRT_WBINNER+ALRT_WBITBLK);
  9816.             max2:=cntbutton*(maxbutton+ALRT_WBORDER);
  9817.             tree^[ROOT].ob_width:=ALRT_WBORDER+max(max1,max2);
  9818.             tree^[ROOT].ob_height:=(3*ALRT_HBORDER+ALRT_HBUTTON)+cnttext;
  9819.             obj:=1;
  9820.             if pbitblk<>nil then
  9821.                 begin
  9822.                     tree^[obj].ob_x:=ALRT_WBORDER;
  9823.                     tree^[obj].ob_y:=ALRT_HBORDER;
  9824.                     tree^[obj].ob_width:=ALRT_WBITBLK;
  9825.                     tree^[obj].ob_height:=ALRT_HBITBLK;
  9826.                     inc(obj)
  9827.                 end;
  9828.             i:=1;
  9829.             while (tree^[obj].ob_type=G_STRING) do
  9830.                 begin
  9831.                     tree^[obj].ob_x:=ALRT_WBORDER;
  9832.                     if pbitblk<>nil then inc(tree^[obj].ob_x,ALRT_WBITBLK+ALRT_WBINNER);
  9833.                     tree^[obj].ob_y:=i;
  9834.                     tree^[obj].ob_width:=maxtext;
  9835.                     tree^[obj].ob_height:=ALRT_HTEXT;
  9836.                     inc(obj);
  9837.                     inc(i)
  9838.                 end;
  9839.             inc(i);
  9840.             xpos:=tree^[ROOT].ob_width-cntbutton*(maxbutton+ALRT_WBORDER);
  9841.             dec(obj);
  9842.             repeat
  9843.                 inc(obj);
  9844.                 tree^[obj].ob_x:=xpos;
  9845.                 tree^[obj].ob_y:=i;
  9846.                 tree^[obj].ob_width:=maxbutton;
  9847.                 tree^[obj].ob_height:=ALRT_HBUTTON;
  9848.                 inc(xpos,maxbutton+ALRT_WBORDER)
  9849.             until bTst(tree^[obj].ob_flags,LASTOB);
  9850.             for i:=0 to treecnt-1 do rsrc_obfix(tree,i)
  9851.         end;
  9852.  
  9853.     begin
  9854.         Alert:=id_No;
  9855.         pbitblk:=nil;
  9856.         if Sign>$7fff then pbitblk:=pointer(Sign)
  9857.         else
  9858.             if (Sign>NO_ICON) and (Sign<=STOP) then
  9859.                 begin
  9860.                     with bbcalc do
  9861.                         begin
  9862.                             bi_pdata:=@highres[Sign];
  9863.                             bi_wb:=4;
  9864.                             bi_hl:=32;
  9865.                             bi_x:=0;
  9866.                             bi_y:=0;
  9867.                             case Sign of
  9868.                                 NOTE: if SysInfo.BGDefCol<>White then bi_color:=Yellow
  9869.                                       else
  9870.                                           bi_color:=LBlack;
  9871.                                 WAIT: bi_color:=Blue;
  9872.                                 STOP: bi_color:=Red
  9873.                             else
  9874.                                 bi_color:=Black
  9875.                             end
  9876.                         end;
  9877.                     pbitblk:=@bbcalc
  9878.                 end;
  9879.         filterzero(Txt);
  9880.         filterzero(Btn);
  9881.         if length(Txt)=0 then Txt:=' '
  9882.         else
  9883.             begin
  9884.                 if pbitblk=nil then Txt:=AlertBubbleWrap(Txt,Min(50,(Attr.MaxPX div SysInfo.SFWidth)-5))
  9885.                 else
  9886.                     txt:=AlertBubbleWrap(Txt,Min(50,(Attr.MaxPX div SysInfo.SFWidth)-10))
  9887.             end;
  9888.         cnttext:=counttokens(Txt,ALRT_MAXLINES);
  9889.         if (cnttext=1) and (pbitblk<>nil) then
  9890.             begin
  9891.                 Txt:='|'+StrPLeft(Txt,254);
  9892.                 cnttext:=2
  9893.             end;
  9894.         cntbutton:=counttokens(Btn,ALRT_MAXBTN);
  9895.         objused:=cnttext+cntbutton+2;
  9896.         getmem(tree,objused*sizeof(AESOBJECT));
  9897.         if tree=nil then exit;
  9898.         createalert;
  9899.         new(adlg,Init(AParent,Name^,id_No));
  9900.         if adlg=nil then
  9901.             begin
  9902.                 freemem(tree,objused*sizeof(AESOBJECT));
  9903.                 exit
  9904.             end
  9905.         else
  9906.             with adlg^ do
  9907.                 begin
  9908.                     SetDlgTree(tree);
  9909.                     SetupSize
  9910.                 end;
  9911.         for i:=firstbutton to firstbutton+cntbutton-1 do new(PButton,Init(adlg,i,id_No,true,''));
  9912.         i:=Attr.Style and as_GrowShrink;
  9913.         if (Sign>NO_ICON) and (Sign<=STOP) then
  9914.             begin
  9915.                 vdi_fix(smfdb,pbitblk,tree^[1].ob_width,tree^[1].ob_height);
  9916.                 vr_convert(vdiHandle,smfdb,FF_DEVSPEC);
  9917.                 smfdb.fd_stand:=FF_DEVSPEC
  9918.             end;
  9919.         Attr.Style:=Attr.Style and not(as_GrowShrink);
  9920.         with adlg^ do
  9921.             begin
  9922.                 Attr.ExStyle:=(Attr.ExStyle and not(ws_ex_TryModeless)) or ws_ex_Center2Parent;
  9923.                 if ltmf=nil then Attr.ExStyle:=Attr.ExStyle or ws_ex_MoveTransparent;
  9924.                 Result:=em_InvalidDialog;
  9925.                 MakeWindow;
  9926.                 if Result>ROOT then Alert:=Result+1-firstbutton
  9927.             end;
  9928.         Attr.Style:=Attr.Style or i;
  9929.         if (Sign>NO_ICON) and (Sign<=STOP) then vr_convert(vdiHandle,smfdb,FF_STAND);
  9930.         adlg^.Free;
  9931.         for i:=firsttext to firsttext+cnttext+cntbutton-1 do ChrDispose(PChar(tree^[i].ob_spec.free_string));
  9932.         freemem(tree,objused*sizeof(AESOBJECT))
  9933.     end;
  9934.  
  9935.  
  9936. function TApplication.Popup(APopup: PPopup; x,y,Flag: integer): integer;
  9937.     var res: integer;
  9938.  
  9939.     begin
  9940.         res:=id_No;
  9941.         if APopup<>nil then
  9942.             begin
  9943.                 with APopup^ do
  9944.                     begin
  9945.                         pX:=x;
  9946.                         pY:=y;
  9947.                         pFlag:=Flag;
  9948.                         res:=Execute
  9949.                     end;
  9950.                 APopup^.Free
  9951.             end;
  9952.         Popup:=res
  9953.     end;
  9954.  
  9955.  
  9956. function TApplication.Rubbox(WHnd,x,y,xmin,ymin,xmax,ymax: integer; IconSel: boolean; var r: GRECT): boolean;
  9957.     var x2,y2,mx,my,mk,dummy: integer;
  9958.         box,cl              : GRECT;
  9959.         pxy2,pxy3,pxy4      : ptsin_ARRAY;
  9960.         wnd                 : PWindow;
  9961.         fmf                 : word;
  9962.         visible             : boolean;
  9963.         pe,pevnt            : PEvent;
  9964.  
  9965.     procedure DrawRubbox;
  9966.  
  9967.         begin
  9968.             if wnd=nil then
  9969.                 begin
  9970.                     wind_get(WHnd,WF_FIRSTXYWH,box.X1,box.Y1,box.X2,box.Y2);
  9971.                     while (box.X2>0) and (box.Y2>0) do
  9972.                         begin
  9973.                             inc(box.X2,box.X1-1);
  9974.                             inc(box.Y2,box.Y1-1);
  9975.                             vs_clip(vdiHandle,CLIP_ON,box.A2);
  9976.                             v_pline(vdiHandle,2,pxya);
  9977.                             v_pline(vdiHandle,2,pxy2);
  9978.                             v_pline(vdiHandle,2,pxy3);
  9979.                             v_pline(vdiHandle,2,pxy4);
  9980.                             wind_get(WHnd,WF_NEXTXYWH,box.X1,box.Y1,box.X2,box.Y2)
  9981.                         end
  9982.                 end
  9983.             else
  9984.                 begin
  9985.                     visible:=wnd^.FirstWorkRect(box);
  9986.                     while visible do
  9987.                         begin
  9988.                             vs_clip(vdiHandle,CLIP_ON,box.A2);
  9989.                             v_pline(vdiHandle,2,pxya);
  9990.                             v_pline(vdiHandle,2,pxy2);
  9991.                             v_pline(vdiHandle,2,pxy3);
  9992.                             v_pline(vdiHandle,2,pxy4);
  9993.                             visible:=wnd^.NextWorkRect(box)
  9994.                         end
  9995.                     end
  9996.         end;
  9997.  
  9998.     begin
  9999.         wind_update(BEG_UPDATE);
  10000.         wind_update(BEG_MCTRL);
  10001.         gem.vsl_udsty(vdiHandle,$5555);
  10002.         gem.vsl_type(vdiHandle,LT_USERDEF);
  10003.         gem.vsl_ends(vdiHandle,LE_SQUARED,LE_SQUARED);
  10004.         gem.vsl_width(vdiHandle,1);
  10005.         fmf:=POINT_HAND;
  10006.         if MultiTOS then fmf:=fmf or MFORCE;
  10007.         gem.graf_mouse(fmf,nil);
  10008.         mx:=x;
  10009.         my:=y;
  10010.         pxya[0]:=x;
  10011.         pxya[1]:=y;
  10012.         pxya[3]:=y;
  10013.         pxy2[1]:=y;
  10014.         pxy3[0]:=x;
  10015.         pxy4[0]:=x;
  10016.         pxy4[1]:=y;
  10017.         pxy4[2]:=x;
  10018.         if WHnd=DESK then
  10019.             begin
  10020.                 wnd:=nil;
  10021.                 pevnt:=EventList
  10022.             end
  10023.         else
  10024.             begin
  10025.                 wnd:=GetGPWindow(WHnd);
  10026.                 if wnd<>nil then pevnt:=wnd^.EventList
  10027.                 else
  10028.                     pevnt:=nil
  10029.             end;
  10030.         if pevnt=nil then IconSel:=false
  10031.         else
  10032.             if IconSel then
  10033.                 begin
  10034.                     pe:=pevnt;
  10035.                     while pe<>nil do
  10036.                         begin
  10037.                             if bTst(pe^.Style,es_Icon) then PIcon(pe)^.rubsel:=false;
  10038.                             pe:=pe^.Next
  10039.                         end
  10040.                 end;
  10041.         HideMouse;
  10042.         repeat
  10043.             x2:=mx;
  10044.             y2:=my;
  10045.             pxya[2]:=x2;
  10046.             pxy2[0]:=x2;
  10047.             pxy2[2]:=x2;
  10048.             pxy2[3]:=y2;
  10049.             pxy3[1]:=y2;
  10050.             pxy3[2]:=x2;
  10051.             pxy3[3]:=y2;
  10052.             pxy4[3]:=y2;
  10053.             if WHnd=DESK then
  10054.                 begin
  10055.                     cl.X1:=Min(x,x2)-DRect.X1;
  10056.                     cl.X2:=Max(x,x2)-DRect.X1;
  10057.                     cl.Y1:=Min(y,y2)-DRect.Y1;
  10058.                     cl.Y2:=Max(y,y2)-DRect.Y1;
  10059.                     A2toGR(cl);
  10060.                     MURBoxChanged(cl)
  10061.                 end
  10062.             else
  10063.                 if wnd<>nil then
  10064.                     begin
  10065.                         cl.X1:=Min(x,x2)-wnd^.Work.X1;
  10066.                         cl.X2:=Max(x,x2)-wnd^.Work.X1;
  10067.                         cl.Y1:=Min(y,y2)-wnd^.Work.Y1;
  10068.                         cl.Y2:=Max(y,y2)-wnd^.Work.Y1;
  10069.                         A2toGR(cl);
  10070.                         wnd^.WMRBoxChanged(cl)
  10071.                     end;
  10072.             if IconSel then
  10073.                 begin
  10074.                     cl.X:=Min(x,x2);
  10075.                     cl.Y:=Min(y,y2);
  10076.                     GRtoA2(cl);
  10077.                     pe:=pevnt;
  10078.                     while pe<>nil do
  10079.                         begin
  10080.                             if bTst(pe^.Style,es_Icon) then
  10081.                                 with PIcon(pe)^ do
  10082.                                     if IsSelectable then
  10083.                                         begin
  10084.                                             if IsSelected(cl) then
  10085.                                                 begin
  10086.                                                     if not(rubsel) then
  10087.                                                         begin
  10088.                                                             Toggle;
  10089.                                                             rubsel:=true
  10090.                                                         end
  10091.                                                 end
  10092.                                             else
  10093.                                                 if rubsel then
  10094.                                                     begin
  10095.                                                         Toggle;
  10096.                                                         rubsel:=false
  10097.                                                     end
  10098.                                         end;
  10099.                             pe:=pe^.Next
  10100.                         end
  10101.                 end;
  10102.             gem.vswr_mode(vdiHandle,MD_XOR);
  10103.             DrawRubbox;
  10104.             ShowMouse;
  10105.             repeat
  10106.                 graf_mkstate(mx,my,mk,dummy);
  10107.                 if mx<xmin then mx:=xmin;
  10108.                 if mx>xmax then mx:=xmax;
  10109.                 if my<ymin then my:=ymin;
  10110.                 if my>ymax then my:=ymax;
  10111.                 if wnd<>nil then wnd^.WMRBoxCheck(x,y,xmin,ymin,xmax,ymax,mx,my)
  10112.             until (x2<>mx) or (y2<>my) or (mk<>1);
  10113.             HideMouse;
  10114.             DrawRubbox
  10115.         until (mk<>1);
  10116.         vs_clip(vdiHandle,CLIP_ON,DRect.A2);
  10117.         ShowMouse;
  10118.         gem.graf_mouse(GP.mnr,@GP.mform);
  10119.         gem.vswr_mode(vdiHandle,GP.wrmode);
  10120.         gem.vsl_width(vdiHandle,GP.lwidth);
  10121.         gem.vsl_ends(vdiHandle,GP.lendsb,GP.lendse);
  10122.         gem.vsl_type(vdiHandle,GP.ltype);
  10123.         gem.vsl_udsty(vdiHandle,GP.ludsty);
  10124.         wind_update(END_MCTRL);
  10125.         wind_update(END_UPDATE);
  10126.         if (mk=0) and (x<>x2) and (y<>y2) then
  10127.             begin
  10128.                 r.X1:=Min(x,x2);
  10129.                 r.X2:=Max(x,x2);
  10130.                 r.Y1:=Min(y,y2);
  10131.                 r.Y2:=Max(y,y2);
  10132.                 if WHnd=DESK then
  10133.                     begin
  10134.                         dec(r.X1,DRect.X1);
  10135.                         dec(r.X2,DRect.X1);
  10136.                         dec(r.Y1,DRect.Y1);
  10137.                         dec(r.Y2,DRect.Y1)
  10138.                     end
  10139.                 else
  10140.                     if wnd<>nil then
  10141.                         begin
  10142.                             dec(r.X1,wnd^.Work.X1);
  10143.                             dec(r.X2,wnd^.Work.X1);
  10144.                             dec(r.Y1,wnd^.Work.Y1);
  10145.                             dec(r.Y2,wnd^.Work.Y1)
  10146.                         end;
  10147.                 A2toGR(r);
  10148.                 Rubbox:=true
  10149.             end
  10150.         else
  10151.             Rubbox:=false
  10152.     end;
  10153.  
  10154.  
  10155. procedure TApplication.InvalidateRect(Wnd: HWnd; Rect: PGRECT);
  10156.     var p   : PWindow;
  10157.         box : GRECT;
  10158.         pipe: Pipearray;
  10159.  
  10160.     begin
  10161.         wind_update(BEG_UPDATE);
  10162.         p:=GetPWindow(Wnd);
  10163.         if p<>nil then
  10164.             with p^ do
  10165.                 begin
  10166.                     if Rect<>nil then box:=Rect^
  10167.                     else
  10168.                         begin
  10169.                             GetWork;
  10170.                             box:=Work
  10171.                         end;
  10172.                     pipe[0]:=WM_REDRAW;
  10173.                     pipe[1]:=apID;
  10174.                     pipe[2]:=0;
  10175.                     pipe[3]:=Attr.gemHandle;
  10176.                     pipe[4]:=box.X;
  10177.                     pipe[5]:=box.Y;
  10178.                     pipe[6]:=box.W;
  10179.                     pipe[7]:=box.H;
  10180.                     appl_write(apID,16,@pipe)
  10181.                 end;
  10182.         wind_update(END_UPDATE)
  10183.     end;
  10184.  
  10185.  
  10186. procedure TApplication.RestoreModalDialog(p: PWindow);
  10187.     var pinfo     : TPaintStruct;
  10188.         pipe      : Pipearray;
  10189.         pw        : PWindow;
  10190.         evnt,dummy: integer;
  10191.  
  10192.     procedure RestoreParent(pwi: PWindow);
  10193.  
  10194.         begin
  10195.             if pwi<>nil then
  10196.                 begin
  10197.                     if pwi^.IsDialog then
  10198.                         with PDialog(pwi)^ do
  10199.                             begin
  10200.                                 if IsModal then
  10201.                                     begin
  10202.                                         RestoreParent(Parent);
  10203.                                         with pinfo do
  10204.                                             begin
  10205.                                                 rcPaint:=Curr;
  10206.                                                 fErase:=false
  10207.                                             end;
  10208.                                         UpdateDialog;
  10209.                                         InitPaint;
  10210.                                         Paint(pinfo);
  10211.                                         ExitPaint
  10212.                                     end
  10213.                             end
  10214.                 end
  10215.         end;
  10216.  
  10217.     begin
  10218.         if p=nil then exit;
  10219.         if not(p^.IsDialog) then exit;
  10220.         if not(PDialog(p)^.IsModal) then exit;
  10221.         wind_update(BEG_UPDATE);
  10222.         repeat
  10223.             evnt:=evnt_multi(MU_TIMER or MU_MESAG,0,0,0,0,0,0,0,0,0,0,0,0,0,pipe,5,0,dummy,dummy,dummy,dummy,dummy,dummy);
  10224.             if bTst(evnt,MU_MESAG) and (pipe[0]=WM_REDRAW) then
  10225.                 begin
  10226.                     pw:=GetGPWindow(pipe[3]);
  10227.                     if pw<>nil then pw^.WMRedraw(pipe[4],pipe[5],pipe[6],pipe[7])
  10228.                 end
  10229.         until evnt=MU_TIMER;
  10230.         HideMouse;
  10231.         RestoreParent(p);
  10232.         ShowMouse;
  10233.         wind_update(END_UPDATE)
  10234.     end;
  10235.  
  10236.  
  10237. procedure TApplication.DeskRedraw;
  10238.     var box: GRECT;
  10239.  
  10240.     begin
  10241.         wind_update(BEG_UPDATE);
  10242.         wind_get(DESK,WF_FIRSTXYWH,box.X,box.Y,box.W,box.H);
  10243.         while (box.W>0) and (box.H>0) do
  10244.             begin
  10245.                 form_dial(FMD_FINISH,0,0,0,0,box.X,box.Y,box.W,box.H);
  10246.                 wind_get(DESK,WF_NEXTXYWH,box.X,box.Y,box.W,box.H)
  10247.             end;
  10248.         wind_update(END_UPDATE)
  10249.     end;
  10250.  
  10251.  
  10252. procedure TApplication.SetQuit(mNum,tNum: integer);
  10253.     var pipe: Pipearray;
  10254.  
  10255.     begin
  10256.         pipe[0]:=GO_PRIVATE;
  10257.         pipe[1]:=apID;
  10258.         pipe[2]:=0;
  10259.         pipe[3]:=GOP_SETQUIT;
  10260.         pipe[4]:=mNum;
  10261.         pipe[5]:=tNum;
  10262.         appl_write(apID,16,@pipe)
  10263.     end;
  10264.  
  10265.  
  10266. procedure TApplication.GetMenuEntries(var Entries: TMenuEntries);
  10267.  
  10268.     begin
  10269.         fillchar(Entries,sizeof(Entries),0)
  10270.     end;
  10271.  
  10272.  
  10273. function TApplication.ChkError: integer;
  10274.  
  10275.     begin
  10276.         ChkError:=Err;
  10277.         Err:=em_OK
  10278.     end;
  10279.  
  10280.  
  10281. function TApplication.ChkSpeedoError: integer;
  10282.  
  10283.     begin
  10284.         ChkSpeedoError:=spderr;
  10285.         spderr:=0
  10286.     end;
  10287.  
  10288.  
  10289. procedure TApplication.Error(ErrorCode: integer);
  10290.     var olderr,oldstat: integer;
  10291.  
  10292.     begin
  10293.         oldstat:=Status;
  10294.         olderr:=Err;
  10295.         Status:=em_OK;
  10296.         Err:=em_OK;
  10297.         if (Attr.Country=FRG) or (Attr.Country=SWG) then
  10298.             case ErrorCode of
  10299.                 em_OK,em_Quit,em_AESNotActive,em_GEMInitFailure,em_Terminate:;
  10300.                 em_InvalidWindow: GOErrAlert(NOTE,'Kein Fenster mehr verfügbar');
  10301.                 em_InvalidMainWindow: GOErrAlert(NOTE,'Hauptfenster nicht verfügbar');
  10302.                 em_AccInitFailure: GOErrAlert(STOP,'Kann Accessory nicht installieren');
  10303.                 em_WOpenFailure: GOErrAlert(NOTE,'Fehler (Fenster öffnen)');
  10304.                 em_WCloseFailure: GOErrAlert(NOTE,'Fehler (Fenster schließen)');
  10305.                 em_WDestroyFailure: GOErrAlert(NOTE,'Fehler (Fenster freigeben)');
  10306.                 em_RscNotFound: GOErrAlert(NOTE,'RSC-Datei nicht gefunden');
  10307.                 em_InvalidMenu: GOErrAlert(NOTE,'Fehler (ungültiges Menü)');
  10308.                 em_InvalidDialog: GOErrAlert(NOTE,'Fehler (ungültiger Dialog)');
  10309.                 em_OutOfMemory: GOErrAlert(STOP,'Kein RAM-Speicher mehr frei')
  10310.             else
  10311.                 GOErrAlert(STOP,'Unbekannter Fehler '+ltoa(ErrorCode))
  10312.             end
  10313.         else
  10314.             case ErrorCode of
  10315.                 em_OK,em_Quit,em_AESNotActive,em_GEMInitFailure,em_Terminate:;
  10316.                 em_InvalidWindow: GOErrAlert(NOTE,'No more windows');
  10317.                 em_InvalidMainWindow: GOErrAlert(NOTE,'Invalid main window');
  10318.                 em_AccInitFailure: GOErrAlert(STOP,'Accessory init Failure');
  10319.                 em_WOpenFailure: GOErrAlert(NOTE,'Window open failure');
  10320.                 em_WCloseFailure: GOErrAlert(NOTE,'Window close failure');
  10321.                 em_WDestroyFailure: GOErrAlert(NOTE,'Window destroy failure');
  10322.                 em_RscNotFound: GOErrAlert(NOTE,'Resource file not found');
  10323.                 em_InvalidMenu: GOErrAlert(NOTE,'Invalid menu structure');
  10324.                 em_InvalidDialog: GOErrAlert(NOTE,'Invalid dialog resource');
  10325.                 em_OutOfMemory: GOErrAlert(STOP,'Error: Out of RAM memory')
  10326.             else
  10327.                 GOErrAlert(STOP,'Unknown error '+ltoa(ErrorCode))
  10328.             end;
  10329.         Status:=oldstat;
  10330.         Err:=olderr
  10331.     end;
  10332.  
  10333.  
  10334.     { private }
  10335.  
  10336.  
  10337. function TApplication.getcval: longint;
  10338.     var ret: longint;
  10339.  
  10340.     begin
  10341.         ret:=ord(Name^[0]) shl 8;
  10342.         if length(Name^)>0 then ret:=(ret+ord(Name^[1])) shl 8;
  10343.         if length(Name^)>1 then ret:=(ret+ord(Name^[2])) shl 8;
  10344.         getcval:=ret
  10345.     end;
  10346.  
  10347.  
  10348. procedure TApplication.MoveIcons(Wnd: PEventObject; Icn: PIcon; gHnd,mX,mY: integer);
  10349.     var bs,ks,x2,y2,dummy,
  10350.         x,y,xl,xr,yo,yu,dest: integer;
  10351.         fmf                 : word;
  10352.         rs,rt               : GRECT;
  10353.         pe                  : PEvent;
  10354.  
  10355.     begin
  10356.         wind_update(BEG_MCTRL);
  10357.         gem.vswr_mode(vdiHandle,MD_XOR);
  10358.         gem.vsl_udsty(vdiHandle,$5555);
  10359.         gem.vsl_type(vdiHandle,LT_USERDEF);
  10360.         gem.vsl_ends(vdiHandle,LE_SQUARED,LE_SQUARED);
  10361.         gem.vsl_width(vdiHandle,1);
  10362.         vs_clip(vdiHandle,CLIP_ON,DRect.A2);
  10363.         fmf:=FLAT_HAND;
  10364.         if MultiTOS then fmf:=fmf or MFORCE;
  10365.         gem.graf_mouse(fmf,nil);
  10366.         x2:=mX;
  10367.         y2:=mY;
  10368.         xl:=maxint;
  10369.         xr:=-maxint;
  10370.         yo:=maxint;
  10371.         yu:=-maxint;
  10372.         pe:=Wnd^.EventList;
  10373.         while pe<>nil do
  10374.             begin
  10375.                 if bTst(pe^.Style,es_Icon) then
  10376.                     if PIcon(pe)^.GetCheck=bf_Checked then
  10377.                         begin
  10378.                             if PIcon(pe)^.GetOutline(rs,rt) then
  10379.                                 begin
  10380.                                     if rt.Y1<yo then yo:=rt.Y1;
  10381.                                     if rt.Y2>yu then yu:=rt.Y2
  10382.                                 end;
  10383.                             if rs.X1<xl then xl:=rs.X1;
  10384.                             if rs.X2>xr then xr:=rs.X2;
  10385.                             if rs.Y1<yo then yo:=rs.Y1;
  10386.                             if rs.Y2>yu then yu:=rs.Y2
  10387.                         end;
  10388.                 pe:=pe^.Next
  10389.             end;
  10390.         dec(xl,mX);
  10391.         dec(xr,mX);
  10392.         dec(yo,mY);
  10393.         dec(yu,mY);
  10394.         HideMouse;
  10395.         repeat
  10396.             x:=x2;
  10397.             y:=y2;
  10398.             pe:=Wnd^.EventList;
  10399.             while pe<>nil do
  10400.                 begin
  10401.                     if bTst(pe^.Style,es_Icon) then
  10402.                         if PIcon(pe)^.GetCheck=bf_Checked then
  10403.                             begin
  10404.                                 if PIcon(pe)^.GetOutline(rs,rt) then
  10405.                                     begin
  10406.                                         pxya[0]:=rt.X-mX+x;
  10407.                                         pxya[1]:=rt.Y-mY+y;
  10408.                                         pxya[2]:=pxya[0]+rt.W-1;
  10409.                                         pxya[3]:=pxya[1];
  10410.                                         pxya[4]:=pxya[2];
  10411.                                         pxya[5]:=pxya[1]+rt.H-1;
  10412.                                         pxya[6]:=pxya[0];
  10413.                                         pxya[7]:=pxya[5];
  10414.                                         pxya[8]:=pxya[0];
  10415.                                         pxya[9]:=pxya[1];
  10416.                                         v_pline(vdiHandle,5,pxya)
  10417.                                     end;
  10418.                                 pxya[0]:=rs.X-mX+x;
  10419.                                 pxya[1]:=rs.Y-mY+y;
  10420.                                 pxya[2]:=pxya[0]+rs.W-1;
  10421.                                 pxya[3]:=pxya[1];
  10422.                                 pxya[4]:=pxya[2];
  10423.                                 pxya[5]:=pxya[1]+rs.H-1;
  10424.                                 pxya[6]:=pxya[0];
  10425.                                 pxya[7]:=pxya[5];
  10426.                                 pxya[8]:=pxya[0];
  10427.                                 pxya[9]:=pxya[1];
  10428.                                 v_pline(vdiHandle,5,pxya)
  10429.                             end;
  10430.                     pe:=pe^.Next
  10431.                 end;
  10432.             ShowMouse;
  10433.             repeat
  10434.                 graf_mkstate(x2,y2,bs,ks);
  10435.                 if xr+x2>DRect.X2 then x2:=DRect.X2-xr;
  10436.                 if xl+x2<DRect.X1 then x2:=DRect.X1-xl;
  10437.                 if yu+y2>DRect.Y2 then y2:=DRect.Y2-yu;
  10438.                 if yo+y2<DRect.Y1 then y2:=DRect.Y1-yo
  10439.             until (x<>x2) or (y<>y2) or (bs<>1);
  10440.             HideMouse;
  10441.             pe:=Wnd^.EventList;
  10442.             while pe<>nil do
  10443.                 begin
  10444.                     if bTst(pe^.Style,es_Icon) then
  10445.                         if PIcon(pe)^.GetCheck=bf_Checked then
  10446.                             begin
  10447.                                 if PIcon(pe)^.GetOutline(rs,rt) then
  10448.                                     begin
  10449.                                         pxya[0]:=rt.X-mX+x;
  10450.                                         pxya[1]:=rt.Y-mY+y;
  10451.                                         pxya[2]:=pxya[0]+rt.W-1;
  10452.                                         pxya[3]:=pxya[1];
  10453.                                         pxya[4]:=pxya[2];
  10454.                                         pxya[5]:=pxya[1]+rt.H-1;
  10455.                                         pxya[6]:=pxya[0];
  10456.                                         pxya[7]:=pxya[5];
  10457.                                         pxya[8]:=pxya[0];
  10458.                                         pxya[9]:=pxya[1];
  10459.                                         v_pline(vdiHandle,5,pxya)
  10460.                                     end;
  10461.                                 pxya[0]:=rs.X-mX+x;
  10462.                                 pxya[1]:=rs.Y-mY+y;
  10463.                                 pxya[2]:=pxya[0]+rs.W-1;
  10464.                                 pxya[3]:=pxya[1];
  10465.                                 pxya[4]:=pxya[2];
  10466.                                 pxya[5]:=pxya[1]+rs.H-1;
  10467.                                 pxya[6]:=pxya[0];
  10468.                                 pxya[7]:=pxya[5];
  10469.                                 pxya[8]:=pxya[0];
  10470.                                 pxya[9]:=pxya[1];
  10471.                                 v_pline(vdiHandle,5,pxya)
  10472.                             end;
  10473.                     pe:=pe^.Next
  10474.                 end
  10475.         until bs<>1;
  10476.         ShowMouse;
  10477.         gem.vswr_mode(vdiHandle,GP.wrmode);
  10478.         gem.vsl_width(vdiHandle,GP.lwidth);
  10479.         gem.vsl_ends(vdiHandle,GP.lendsb,GP.lendse);
  10480.         gem.vsl_type(vdiHandle,GP.ltype);
  10481.         gem.vsl_udsty(vdiHandle,GP.ludsty);
  10482.         gem.graf_mouse(GP.mnr,@GP.mform);
  10483.         wind_update(END_MCTRL);
  10484.         if (bs=0) and ((x<>mX) or (y<>mY)) then
  10485.             begin
  10486.                 if gHnd=DESK then exit; { ... }
  10487.                 dest:=wind_find(x,y);
  10488.                 if (dest=gHnd) and Between(x,PWindow(Wnd)^.Work.X1,PWindow(Wnd)^.Work.X2) and Between(y,PWindow(Wnd)^.Work.Y1,PWindow(Wnd)^.Work.Y2) then
  10489.                     begin
  10490.                         pe:=Wnd^.EventList;
  10491.                         while pe<>nil do
  10492.                             begin
  10493.                                 if bTst(pe^.Style,es_Icon) then
  10494.                                     with PIcon(pe)^ do
  10495.                                         if GetCheck=bf_Checked then IMMoved(XPos-mX+x,YPos-mY+y);
  10496.                                 pe:=pe^.Next
  10497.                             end
  10498.                     end;
  10499.                 { ... }
  10500.             end
  10501.     end;
  10502.  
  10503.  
  10504. function TApplication.GetObjectParent(tree: PTree; indx: integer): integer;
  10505.     var p,np: integer;
  10506.  
  10507.     begin
  10508.         p:=-1;
  10509.         np:=tree^[indx].ob_next;
  10510.         while (np>-1) and (p=-1) do
  10511.             begin
  10512.                 if tree^[np].ob_tail=indx then p:=np;
  10513.                 indx:=np;
  10514.                 np:=tree^[indx].ob_next
  10515.             end;
  10516.         GetObjectParent:=p
  10517.     end;
  10518.  
  10519.  
  10520. function TApplication.find_object(tree: PTree; start,which: integer): integer;
  10521.     label _again;
  10522.  
  10523.     var obj,flag,increment,objmax: integer;
  10524.  
  10525.     function IsHidden: boolean;
  10526.         var hid : boolean;
  10527.                 pobj: integer;
  10528.  
  10529.         begin
  10530.             hid:=false;
  10531.             pobj:=obj;
  10532.             while not(hid) and (pobj>-1) do
  10533.                 begin
  10534.                     hid:=bTst(tree^[pobj].ob_flags,HIDETREE);
  10535.                     pobj:=GetObjectParent(tree,pobj)
  10536.                 end;
  10537.             IsHidden:=hid
  10538.         end;
  10539.  
  10540.     begin
  10541.         obj:=0;
  10542.         flag:=EDITABLE;
  10543.         increment:=1;
  10544.         if which=FMD_BACKWARD then increment:=-1;
  10545.         if (which=FMD_BACKWARD) or (which=FMD_FORWARD) then obj:=start+increment;
  10546.         if which=FMD_DEFLT then flag:=DEFAULT;
  10547.         objmax:=0;
  10548.         if tree^[ROOT].ob_head>=0 then
  10549.             repeat
  10550.                 objmax:=tree^[objmax].ob_tail
  10551.             until tree^[objmax].ob_head=-1;
  10552.         _again:
  10553.         while (obj>=0) and (obj<=objmax) do
  10554.             begin
  10555.                 with tree^[obj] do
  10556.                     if bTst(ob_flags,flag) and not(bTst(ob_state,DISABLED)) and not(IsHidden) then
  10557.                         begin
  10558.                             find_object:=obj;
  10559.                             exit
  10560.                         end;
  10561.                 inc(obj,increment)
  10562.             end;
  10563.         if (obj<0) and (start>0) then
  10564.             begin
  10565.                 obj:=objmax;
  10566.                 goto _again
  10567.             end;
  10568.         if (obj>objmax) and (start>0) then
  10569.             begin
  10570.                 obj:=0;
  10571.                 goto _again
  10572.             end;
  10573.         find_object:=start
  10574.     end;
  10575.  
  10576.  
  10577. function TApplication.ini_field(tree: PTree; start: integer): integer;
  10578.  
  10579.     begin
  10580.         if start=0 then start:=find_object(tree,0,FMD_FORWARD);
  10581.         ini_field:=start
  10582.     end;
  10583.  
  10584.  
  10585. function TApplication.form_keybd(fo_ktree: PTree; fo_kobject,fo_kobnext,fo_kchar: integer; var fo_knxtobject,fo_knxtchar: integer): integer;
  10586.  
  10587.     begin
  10588.         form_keybd:=1;
  10589.         fo_knxtchar:=0;
  10590.         case fo_kchar of
  10591.             Tab: if (Kbshift(-1) and K_SHIFT)>0 then fo_knxtobject:=find_object(fo_ktree,fo_kobject,FMD_BACKWARD)
  10592.                      else
  10593.                          fo_knxtobject:=find_object(fo_ktree,fo_kobject,FMD_FORWARD);
  10594.             Return,Enter: begin
  10595.                                             fo_knxtobject:=find_object(fo_ktree,-1,FMD_DEFLT);
  10596.                                             if fo_knxtobject=-1 then fo_knxtobject:=fo_kobject
  10597.                                             else
  10598.                                                 form_keybd:=0
  10599.                                         end;
  10600.             Cur_Up:   fo_knxtobject:=find_object(fo_ktree,fo_kobject,FMD_BACKWARD);
  10601.             Cur_Down: fo_knxtobject:=find_object(fo_ktree,fo_kobject,FMD_FORWARD);
  10602.             Shift_Home,Shift_CD: fo_knxtobject:=find_object(fo_ktree,ini_field(fo_ktree,0),FMD_BACKWARD);
  10603.             Home,Shift_CU: fo_knxtobject:=ini_field(fo_ktree,0)
  10604.         else
  10605.             begin
  10606.                 fo_knxtobject:=fo_kobject;
  10607.                 fo_knxtchar:=fo_kchar
  10608.             end
  10609.         end;
  10610.     end;
  10611.  
  10612.  
  10613. function TApplication.form_button(pd: PDialog; fo_bobject,fo_bclicks: integer; var fo_bnxtobj: integer): boolean;
  10614.     label _raus;
  10615.  
  10616.     var obs,obf,robj,dummy,bx,by: integer;
  10617.         brect,mrect             : GRECT;
  10618.         onbtn,inrect,visible    : boolean;
  10619.         bnxo                    : word;
  10620.  
  10621.     begin
  10622.         form_button:=true;
  10623.         fo_bnxtobj:=0;
  10624.         obs:=pd^.DlgTree^[fo_bobject].ob_state;
  10625.         obf:=pd^.DlgTree^[fo_bobject].ob_flags;
  10626.         if bTst(obs,DISABLED) or bTst(obf,HIDETREE) then exit;
  10627.         wind_update(BEG_UPDATE);
  10628.         wind_update(BEG_MCTRL);
  10629.         if bTst(obf,SELECTABLE) then
  10630.             begin
  10631.                 if bTst(obf,RBUTTON) then
  10632.                     begin
  10633.                         if not(bTst(obs,SELECTED)) then
  10634.                             begin
  10635.                                 robj:=fo_bobject;
  10636.                                 repeat
  10637.                                     dummy:=pd^.DlgTree^[robj].ob_next;
  10638.                                     if pd^.DlgTree^[dummy].ob_tail=robj then
  10639.                                         robj:=pd^.DlgTree^[dummy].ob_head
  10640.                                     else
  10641.                                         robj:=dummy;
  10642.                                     if bTst(pd^.DlgTree^[robj].ob_state,SELECTED) then
  10643.                                         begin
  10644.                                             objc_change(pd^.DlgTree,robj,0,0,0,1,1,pd^.DlgTree^[robj].ob_state and not(SELECTED),1);
  10645.                                             pd^.ObjcPaint(robj,false)
  10646.                                         end;
  10647.                                 until robj=fo_bobject;
  10648.                                 objc_change(pd^.DlgTree,fo_bobject,0,0,0,1,1,obs or SELECTED,1);
  10649.                                 pd^.ObjcPaint(fo_bobject,false);
  10650.                                 repeat
  10651.                                     graf_mkstate(dummy,dummy,robj,dummy)
  10652.                                 until not(bTst(robj,1))
  10653.                             end
  10654.                     end
  10655.                 else
  10656.                     if bTst(obf,F_EXIT) then
  10657.                         begin
  10658.                             obs:=obs or SELECTED;
  10659.                             objc_change(pd^.DlgTree,fo_bobject,0,0,0,1,1,obs,1);
  10660.                             pd^.ObjcPaint(fo_bobject,false);
  10661.                             objc_offset(pd^.DlgTree,fo_bobject,bx,by);
  10662.                             with brect do
  10663.                                 begin
  10664.                                     X:=bx;
  10665.                                     Y:=by;
  10666.                                     W:=pd^.DlgTree^[fo_bobject].ob_width;
  10667.                                     H:=pd^.DlgTree^[fo_bobject].ob_height
  10668.                                 end;
  10669.                             onbtn:=true;
  10670.                             repeat
  10671.                                 graf_mkstate(bx,by,robj,dummy);
  10672.                                 if pd^.IsModal then
  10673.                                     inrect:=((bx>=brect.X) and (by>=brect.Y) and (bx<brect.X+brect.W) and (by<brect.Y+brect.H))
  10674.                                 else
  10675.                                     begin
  10676.                                         inrect:=false;
  10677.                                         visible:=pd^.FirstWorkRect(mrect);
  10678.                                         while visible do
  10679.                                             begin
  10680.                                                 if rc_intersect(brect,mrect) then
  10681.                                                     with mrect do
  10682.                                                         if (bx>=X1) and (by>=Y1) and (bx<=X2) and (by<=Y2) then inrect:=true;
  10683.                                                 visible:=pd^.NextWorkRect(mrect)
  10684.                                             end
  10685.                                     end;
  10686.                                 if inrect<>onbtn then
  10687.                                     begin
  10688.                                         obs:=obs xor SELECTED;
  10689.                                         objc_change(pd^.DlgTree,fo_bobject,0,0,0,1,1,obs,1);
  10690.                                         pd^.ObjcPaint(fo_bobject,false);
  10691.                                         onbtn:=inrect
  10692.                                     end
  10693.                             until not(bTst(robj,1));
  10694.                             if not(onbtn) then goto _raus
  10695.                         end
  10696.                     else
  10697.                         begin
  10698.                             objc_change(pd^.DlgTree,fo_bobject,0,0,0,1,1,obs xor SELECTED,1);
  10699.                             pd^.ObjcPaint(fo_bobject,false);
  10700.                             if not(bTst(obf,TOUCHEXIT)) then
  10701.                                 repeat
  10702.                                     graf_mkstate(dummy,dummy,robj,dummy)
  10703.                                 until not(bTst(robj,1))
  10704.                         end
  10705.             end;
  10706.         if (obf and (F_EXIT or TOUCHEXIT or EDITABLE))>0 then
  10707.             begin
  10708.                 fo_bnxtobj:=fo_bobject;
  10709.                 if (obf and (F_EXIT or TOUCHEXIT))>0 then form_button:=false;
  10710.                 if bTst(obf,TOUCHEXIT) and (fo_bclicks>1) then
  10711.                     begin
  10712.                         bnxo:=fo_bnxtobj or $8000;
  10713.                         fo_bnxtobj:=integer(bnxo)
  10714.                     end
  10715.             end;
  10716.         _raus:
  10717.         wind_update(END_MCTRL);
  10718.         wind_update(END_UPDATE)
  10719.     end;
  10720.  
  10721.  
  10722. procedure TApplication.GOErrAlert(sign: integer; msg: string);
  10723.  
  10724.     begin
  10725.         Alert(nil,1,sign,'"'+StrPLeft(StrPTrimF(Name^),26)+'":|'+msg,'  &OK  ')
  10726.     end;
  10727.  
  10728.  
  10729. function TApplication.XAccMR2HR(MR: TAppTypeMR): string;
  10730.     label _raus;
  10731.  
  10732.     const txt : array [0..25] of string[28] =
  10733.            ('word processor',
  10734.             'DTP',
  10735.             'text editor',
  10736.             'database',
  10737.             'spreadsheet',
  10738.             'raster graphics application',
  10739.             'vector graphics application',
  10740.             'general graphics application',
  10741.             'music application',
  10742.             'CAD',
  10743.             'data communication',
  10744.             'desktop',
  10745.             'programming environment',
  10746.             'Textverarbeitung',
  10747.             'DTP',
  10748.             'Texteditor',
  10749.             'Datenbank',
  10750.             'Tabellenkalkulation',
  10751.             'Rastergrafikprogramm',
  10752.             'Vektorgrafikprogramm',
  10753.             'Allgemeines Grafikprogramm',
  10754.             'Musikprogramm',
  10755.             'CAD',
  10756.             'Datenkommunikation',
  10757.             'Desktop',
  10758.             'Programmiersprache');
  10759.  
  10760.     var ret: integer;
  10761.  
  10762.     begin
  10763.         ret:=-1;
  10764.         if length(MR)<>2 then goto _raus;
  10765.         case (ord(MR[1]) shl 8)+ord(MR[2]) of
  10766.             22352: ret:=0;
  10767.             17488: ret:=1;
  10768.             17732: ret:=2;
  10769.             17474: ret:=3;
  10770.             21331: ret:=4;
  10771.             21063: ret:=5;
  10772.             22087: ret:=6;
  10773.             18247: ret:=7;
  10774.             19797: ret:=8;
  10775.             17220: ret:=9;
  10776.             17475: ret:=10;
  10777.             17492: ret:=11;
  10778.             20549: ret:=12
  10779.         end;
  10780.         if (Attr.Country=FRG) or (Attr.Country=SWG) then inc(ret,13);
  10781.         _raus:
  10782.         if ret>=0 then XAccMR2HR:=txt[ret]
  10783.         else
  10784.             XAccMR2HR:=''
  10785.     end;
  10786.  
  10787.  
  10788. function TApplication.AlertBubbleWrap(txt: string; width: integer): string;
  10789.     label _again;
  10790.  
  10791.     var ret: string;
  10792.         t  : integer;
  10793.  
  10794.     procedure add(s: string);
  10795.         label _nochmal;
  10796.  
  10797.         var i: integer;
  10798.  
  10799.         begin
  10800.             _nochmal:
  10801.             StrPTrim(s);
  10802.             if length(s)>width then
  10803.                 begin
  10804.                     i:=width;
  10805.                     while not(s[i] in [' ',',','.',';','?','!',':','-','+',')','\']) and (i>0) do dec(i);
  10806.                     if i=0 then i:=width;
  10807.                     ret:=ret+StrPTrimF(StrPLeft(s,i))+'|';
  10808.                     s:=StrPRight(s,length(s)-i);
  10809.                     goto _nochmal
  10810.                 end;
  10811.             ret:=ret+s
  10812.         end;
  10813.  
  10814.     begin
  10815.         if width<2 then width:=2;
  10816.         ret:='';
  10817.         _again:
  10818.         StrPTrim(txt);
  10819.         t:=pos('|',txt);
  10820.         if t>0 then
  10821.             begin
  10822.                 if t>width+1 then
  10823.                     begin
  10824.                         add(StrPLeft(txt,t-1));
  10825.                         ret:=ret+'|';
  10826.                         txt:=StrPRight(txt,length(txt)-t)
  10827.                     end
  10828.                 else
  10829.                     begin
  10830.                         ret:=ret+StrPTrimF(StrPLeft(txt,t-1))+'|';
  10831.                         txt:=StrPRight(txt,length(txt)-t)
  10832.                     end;
  10833.                 goto _again
  10834.             end;
  10835.         add(txt);
  10836.         AlertBubbleWrap:=ret
  10837.     end;
  10838.  
  10839.  
  10840. procedure    TApplication.FixResource(raddr: pointer; mode,what: boolean);
  10841.     label _bitblks;
  10842.  
  10843.     var rsf           : PRsFile;
  10844.         rsh           : RSHDRPtr;
  10845.         tree          : PTree;
  10846.         pool          : AESTreePtrArrayPtr;
  10847.         tedinfo       : TedinfoArrayPtr;
  10848.         iconblk       : IconBlockArrayPtr;
  10849.         bitblk        : BitBlockArrayPtr;
  10850.         fstrpool      : FreeStrPtrArrayPtr;
  10851.         fimgpool      : FreeImgPtrArrayPtr;
  10852.         obj,objCnt,typ: integer;
  10853.         offset        : longint;
  10854.         theMFDB       : MFDB;
  10855.         taddr         : pointer;
  10856.  
  10857.     procedure    AbsToRelCoords(var coord: integer; defCharSize: integer);
  10858.  
  10859.         begin
  10860.             coord:=((coord mod defCharSize) shl 8)+(coord div defCharSize)
  10861.         end;
  10862.  
  10863.     procedure    RelToAbsCoords(var coord: integer; defCharSize: integer);
  10864.  
  10865.         begin
  10866.             coord:=((coord and $ff)*defCharSize)+(coord shr 8)
  10867.         end;
  10868.  
  10869.     procedure FixBitBlks;
  10870.         var obj: integer;
  10871.  
  10872.         begin
  10873.             if rsh^.rsh_nib>0 then
  10874.                 for obj:=0 to rsh^.rsh_nib-1 do
  10875.                     with iconblk^[obj] do
  10876.                         begin
  10877.                             taddr:=ib_pdata;
  10878.                             if taddr<>nil then
  10879.                                 begin
  10880.                                     vdi_fix(theMFDB,taddr,ib_wicon,ib_hicon);
  10881.                                     vr_convert(vdiHandle,theMFDB,FF_DEVSPEC)
  10882.                                 end;
  10883.                             taddr:=ib_pmask;
  10884.                             if taddr<>nil then
  10885.                                 begin
  10886.                                     vdi_fix(theMFDB,taddr,ib_wicon,ib_hicon);
  10887.                                     vr_convert(vdiHandle,theMFDB,FF_DEVSPEC)
  10888.                                 end
  10889.                         end;
  10890.             if rsh^.rsh_nbb>0 then
  10891.                 for obj:=0 to rsh^.rsh_nbb-1 do
  10892.                     with bitblk^[obj] do
  10893.                         begin
  10894.                             taddr:=bi_pdata;
  10895.                             if taddr<>nil then
  10896.                                 begin
  10897.                                     vdi_fix(theMFDB,taddr,bi_wb shl 3,bi_hl);
  10898.                                     vr_convert(vdiHandle,theMFDB,FF_DEVSPEC)
  10899.                                 end
  10900.                         end
  10901.         end;
  10902.  
  10903.     procedure UnfixBitBlks;
  10904.         var obj: integer;
  10905.  
  10906.         begin
  10907.             if rsh^.rsh_nib>0 then
  10908.                 for obj:=0 to rsh^.rsh_nib-1 do
  10909.                     with iconblk^[obj] do
  10910.                         begin
  10911.                             taddr:=ib_pdata;
  10912.                             if taddr<>nil then
  10913.                                 begin
  10914.                                     vdi_fix(theMFDB,taddr,ib_wicon,ib_hicon);
  10915.                                     theMFDB.fd_stand:=FF_DEVSPEC;
  10916.                                     vr_convert(vdiHandle,theMFDB,FF_STAND)
  10917.                                 end;
  10918.                             taddr:=ib_pmask;
  10919.                             if taddr<>nil then
  10920.                                 begin
  10921.                                     vdi_fix(theMFDB,taddr,ib_wicon,ib_hicon);
  10922.                                     theMFDB.fd_stand:=FF_DEVSPEC;
  10923.                                     vr_convert(vdiHandle,theMFDB,FF_STAND)
  10924.                                 end
  10925.                         end;
  10926.             if rsh^.rsh_nbb>0 then
  10927.                 for obj:=0 to rsh^.rsh_nbb-1 do
  10928.                     with bitblk^[obj] do
  10929.                         begin
  10930.                             taddr:=bi_pdata;
  10931.                             if taddr<>nil then
  10932.                                 begin
  10933.                                     vdi_fix(theMFDB,taddr,bi_wb shl 3,bi_hl);
  10934.                                     theMFDB.fd_stand:=FF_DEVSPEC;
  10935.                                     vr_convert(vdiHandle,theMFDB,FF_STAND)
  10936.                                 end
  10937.                         end
  10938.         end;
  10939.  
  10940.     begin
  10941.         offset:=longint(raddr);
  10942.         rsf:=raddr;
  10943.         rsh:=@rsf^.rsh;
  10944.         tree:=@rsf^.rsd[rsh^.rsh_object];
  10945.         tedinfo:=@rsf^.rsd[rsh^.rsh_tedinfo];
  10946.         iconblk:=@rsf^.rsd[rsh^.rsh_iconblk];
  10947.         bitblk:=@rsf^.rsd[rsh^.rsh_bitblk];
  10948.         pool:=@rsf^.rsd[rsh^.rsh_trindex];
  10949.         fstrpool:=@rsf^.rsd[rsh^.rsh_frstr];
  10950.         fimgpool:=@rsf^.rsd[rsh^.rsh_frimg];
  10951.         if mode=UNFIXRSC then
  10952.             begin
  10953.                 offset:=-offset;
  10954.                 UnfixBitBlks
  10955.             end;
  10956.         if what=FIX_BBONLY then goto _bitblks;
  10957.         if rsh^.rsh_nobs>0 then
  10958.             for obj:=0 to rsh^.rsh_nobs-1 do
  10959.                 with tree^[obj] do
  10960.                     begin
  10961.                         if mode=FIXRSC then
  10962.                             begin
  10963.                                 RelToAbsCoords(ob_x,Attr.charSWidth);
  10964.                                 RelToAbsCoords(ob_y,Attr.charSHeight);
  10965.                                 RelToAbsCoords(ob_width,Attr.charSWidth);
  10966.                                 RelToAbsCoords(ob_height,Attr.charSHeight);
  10967.                             end
  10968.                         else
  10969.                             begin
  10970.                                 AbsToRelCoords(ob_x,Attr.charSWidth);
  10971.                                 AbsToRelCoords(ob_y,Attr.charSHeight);
  10972.                                 AbsToRelCoords(ob_width,Attr.charSWidth);
  10973.                                 AbsToRelCoords(ob_height,Attr.charSHeight);
  10974.                             end;
  10975.                         typ:=ob_type and $ff;
  10976.                         if (typ=G_TEXT) or (typ=G_BOXTEXT) or (typ=G_FTEXT) or
  10977.                            (typ=G_FBOXTEXT) or (typ=G_BUTTON) or (typ=G_STRING) or
  10978.                            (typ=G_TITLE ) or (typ=G_ICON) or (typ=G_IMAGE) then inc(ob_spec.index,offset)
  10979.                     end;
  10980.         if rsh^.rsh_nted>0 then
  10981.             for obj:=0 to rsh^.rsh_nted-1 do
  10982.                 with tedinfo^[obj] do
  10983.                     begin
  10984.                         inc(longint(te_ptext),offset);
  10985.                         inc(longint(te_ptmplt),offset);
  10986.                         inc(longint(te_pvalid),offset)
  10987.                     end;
  10988.         if rsh^.rsh_nib>0 then
  10989.             for obj:=0 to rsh^.rsh_nib-1 do
  10990.                 with iconblk^[obj] do
  10991.                     begin
  10992.                         inc(longint(ib_pmask),offset);
  10993.                         inc(longint(ib_pdata),offset);
  10994.                         inc(longint(ib_ptext),offset)
  10995.                     end;
  10996.         if rsh^.rsh_nbb>0 then
  10997.             for obj:=0 to rsh^.rsh_nbb-1 do inc(longint(bitblk^[obj].bi_pdata),offset);
  10998.         if rsh^.rsh_ntree>0 then
  10999.             for obj:=0 to rsh^.rsh_ntree-1 do inc(longint(pool^[obj]),offset);
  11000.         if rsh^.rsh_nstring>0 then
  11001.             for obj:=0 to rsh^.rsh_nstring-1 do inc(longint(fstrpool^[obj]),offset);
  11002.         if rsh^.rsh_nimages>0 then
  11003.             for obj:=0 to rsh^.rsh_nimages-1 do inc(longint(fimgpool^[obj]),offset);
  11004.         _bitblks:
  11005.         if mode=FIXRSC then FixBitBlks
  11006.     end;
  11007.  
  11008.  
  11009. function TApplication.MenuCorrect(mt: PTree; var i: integer): boolean;
  11010.     var abs_x,abs_y: integer;
  11011.  
  11012.     begin
  11013.         if (mt^[mt^[2].ob_tail].ob_x+mt^[mt^[2].ob_tail].ob_width+mt^[2].ob_x)>(DRect.X+DRect.W) then MenuCorrect:=false
  11014.         else
  11015.             begin
  11016.                 i:=mt^[mt^[ROOT].ob_tail].ob_head-1;
  11017.                 repeat
  11018.                     inc(i);
  11019.                     with mt^[i] do
  11020.                         if ((ob_type and $ff)=G_BOX) then
  11021.                             begin
  11022.                                 if ((ob_width>=DRect.W) or (ob_height>=DRect.H)) then
  11023.                                     begin
  11024.                                         MenuCorrect:=false;
  11025.                                         exit
  11026.                                     end;
  11027.                                 objc_offset(mt,i,abs_x,abs_y);
  11028.                                 if (abs_x>=(DRect.X+DRect.W-ob_width)) then dec(ob_x,abs_x+1-(DRect.X+DRect.W-ob_width))
  11029.                             end
  11030.                 until bTst(mt^[i].ob_flags,LASTOB);
  11031.                 with mt^[ROOT] do
  11032.                     begin
  11033.                         ob_x:=0;
  11034.                         ob_y:=0;
  11035.                         ob_width:=Attr.MaxPX+1;
  11036.                         ob_height:=Attr.MaxPY+1;
  11037.                         with mt^[ob_head] do ob_width:=mt^[ROOT].ob_width
  11038.                     end;
  11039.                 inc(i);
  11040.                 MenuCorrect:=true
  11041.             end
  11042.     end;
  11043.  
  11044.  
  11045. procedure TApplication.MenuTune;
  11046.     var i: integer;
  11047.  
  11048.     begin
  11049.         i:=-1;
  11050.         mnusr.ub_parm:=0;
  11051.         mnusr.ub_code:=@DrawMenuRect;
  11052.         repeat
  11053.             inc(i);
  11054.             with MenuTree^[i] do
  11055.                 if ((ob_type and $ff)=G_STRING) then
  11056.                     if bTst(ob_state,DISABLED) and (PChar(ob_spec.free_string)^='-') then
  11057.                         begin
  11058.                             ob_type:=G_USERDEF;
  11059.                             ob_spec.user_blk:=@mnusr
  11060.                         end
  11061.         until bTst(MenuTree^[i].ob_flags,LASTOB)
  11062.     end;
  11063.  
  11064.  
  11065. procedure TApplication.TitleSelect(pw: PWindow; indx: integer; select: boolean);
  11066.     var box  : GRECT;
  11067.         start: integer;
  11068.  
  11069.     begin
  11070.         with pw^ do
  11071.             begin
  11072.                 wind_update(BEG_UPDATE);
  11073.                 with Class.MenuTree^[indx] do
  11074.                     if select then ob_state:=ob_state or SELECTED
  11075.                     else
  11076.                         ob_state:=ob_state and not(SELECTED);
  11077.                 start:=Class.MenuTree^[ROOT].ob_head;
  11078.                 if select then start:=Class.MenuTree^[start].ob_head;
  11079.                 HideMouse;
  11080.                 wind_get(Attr.gemHandle,WF_FIRSTXYWH,box.X,box.Y,box.W,box.H);
  11081.                 while (box.W>0) and (box.H>0) do
  11082.                     begin
  11083.                         if rc_intersect(DRect,box) then
  11084.                             with box do objc_draw(Class.MenuTree,start,MAX_DEPTH,X,Y,W,H);
  11085.                         wind_get(Attr.gemHandle,WF_NEXTXYWH,box.X,box.Y,box.W,box.H)
  11086.                     end;
  11087.                 ShowMouse;
  11088.                 wind_update(END_UPDATE)
  11089.             end
  11090.     end;
  11091.  
  11092. { *** TAPPLICATION *** }
  11093.  
  11094.  
  11095.  
  11096. { *** Objekt TDIALOG *** }
  11097.  
  11098. constructor TDialog.Init(AParent: PWindow; ATitle: string; Indx: integer);
  11099.  
  11100.     begin
  11101.         if not(inherited Init(AParent,ATitle)) then fail;
  11102.         DisableAutoCreate;
  11103.         if Indx<>id_No then
  11104.             begin
  11105.                 Application^.ChkError;
  11106.                 LoadDialog(Indx);
  11107.                 if Application^.Err<em_OK then
  11108.                     begin
  11109.                         inherited Done;
  11110.                         fail
  11111.                     end;
  11112.                 SetupSize
  11113.             end;
  11114.         if Icon=nil then
  11115.             if Application^.ticn>ROOT then
  11116.                 LoadIcon(new(PIcon,Init(@self,Application^.ticn,Application^.iicn,0,0,false,false,'','')));
  11117.         if AppFlag then
  11118.             if bTst(Class.Style,cs_AutoOpen) then MakeWindow
  11119.     end;
  11120.  
  11121.  
  11122. destructor TDialog.Done;
  11123.     var dummy: integer;
  11124.  
  11125.     begin
  11126.         edit_obj:=0;
  11127.         next_obj:=0;
  11128.         Cont:=false;
  11129.         pedt:=nil;
  11130.         while (CtrlList<>nil) do CtrlList^.Free;
  11131.         inherited Done
  11132.     end;
  11133.  
  11134.  
  11135. function TDialog.GetStyle: integer;
  11136.     var ret: integer;
  11137.  
  11138.     begin
  11139.         ret:=NAME or CLOSER or MOVER;
  11140.         if agi.Iconify then
  11141.             begin
  11142.                 if TOSVersion=$0492 then ret:=ret or $1000
  11143.                 else
  11144.                     ret:=ret or SMALLER
  11145.             end;
  11146.         if bTst(agi.Gadgets,2) then ret:=ret or BACKDROP;
  11147.         GetStyle:=ret
  11148.     end;
  11149.  
  11150.  
  11151. procedure TDialog.GetWindowClass(var AWndClass: TWndClass);
  11152.  
  11153.     begin
  11154.         inherited GetWindowClass(AWndClass);
  11155.         with AWndClass do
  11156.             begin
  11157.                 Style:=(Style and not(cs_CreateOnAccOpen or cs_AutoOpen or cs_QuitOnClose)) or cs_SaveBits or cs_WorkBackground;
  11158.                 hbrBackground:=0
  11159.             end
  11160.     end;
  11161.  
  11162.  
  11163. function TDialog.GetClassName: string;
  11164.  
  11165.     begin
  11166.         GetClassName:='Dialog'
  11167.     end;
  11168.  
  11169.  
  11170. function TDialog.GetKBHandler: PEvent;
  11171.  
  11172.     begin
  11173.         GetKBHandler:=kbdh
  11174.     end;
  11175.  
  11176.  
  11177. function TDialog.IsDialog: boolean;
  11178.  
  11179.     begin
  11180.         IsDialog:=true
  11181.     end;
  11182.  
  11183.  
  11184. procedure TDialog.LoadDialog(Indx: integer);
  11185.     var tp   : PTree;
  11186.         valid: boolean;
  11187.  
  11188.     function GetDPWindow: PWindow;
  11189.         var p,pc,pc2: PWindow;
  11190.  
  11191.         begin
  11192.             p:=Application^.MainWindow;
  11193.             while (p<>nil) do
  11194.                 begin
  11195.                     if (p^.DlgTree=tp) or (p^.Class.ToolbarTree=tp) then
  11196.                         begin
  11197.                             GetDPWindow:=p;
  11198.                             exit
  11199.                         end;
  11200.                     pc:=p^.ChildList;
  11201.                     if (pc<>nil) then
  11202.                         begin
  11203.                             while (pc^.ChildList<>nil) do pc:=pc^.ChildList;
  11204.                             repeat
  11205.                                 pc2:=pc;
  11206.                                 while (pc2<>nil) do
  11207.                                     with pc2^ do
  11208.                                         begin
  11209.                                             if (DlgTree=tp) or (Class.ToolbarTree=tp) then
  11210.                                                 begin
  11211.                                                     GetDPWindow:=pc2;
  11212.                                                     exit
  11213.                                                 end;
  11214.                                             pc2:=Nxt
  11215.                                         end;
  11216.                                 pc:=pc^.Parent
  11217.                             until pc=p
  11218.                         end;
  11219.                     p:=p^.Nxt
  11220.                 end;
  11221.             GetDPWindow:=nil
  11222.         end;
  11223.  
  11224.     begin
  11225.         valid:=false;
  11226.         tp:=Application^.GetAddr(Indx);
  11227.         if tp<>nil then valid:=(GetDPWindow=nil);
  11228.         if valid then inherited LoadDialog(Indx)
  11229.         else
  11230.             Application^.Err:=em_InvalidDialog
  11231.     end;
  11232.  
  11233.  
  11234. procedure TDialog.UpdateDialog;
  11235.  
  11236.     begin
  11237.         if IsModal then Work:=Curr;
  11238.         inherited UpdateDialog
  11239.     end;
  11240.  
  11241.  
  11242. procedure TDialog.SetupSize;
  11243.     var wmw,wmh: integer;
  11244.         r      : GRECT;
  11245.  
  11246.     begin
  11247.         inherited SetupSize;
  11248.         with DlgTree^[ROOT] do
  11249.             begin
  11250.                 Work.W:=ob_width;
  11251.                 Work.H:=ob_height
  11252.             end;
  11253.         wmaxw:=Work.W;
  11254.         wmaxh:=Work.H;
  11255.         GetWorkMax(wmw,wmh);
  11256.         if (wmw>wmaxw) or (wmh>wmaxh) then
  11257.             begin
  11258.                 Calc(WC_WORK,DRect,r);
  11259.                 if wmw>wmaxw then Work.W:=Min(wmw,r.W);
  11260.                 if wmh>wmaxh then Work.H:=Min(wmh,r.H)
  11261.             end;
  11262.         Calc(WC_BORDER,Work,Curr)
  11263.     end;
  11264.  
  11265.  
  11266. procedure TDialog.SetupWindow;
  11267.  
  11268.     begin
  11269.         Attr.ExStyle:=ws_ex_TryModeless or ws_ex_CenterOnce;
  11270.         if bTst(Application^.Attr.Style,as_MoveTransparent) then
  11271.             Attr.ExStyle:=Attr.ExStyle or ws_ex_MoveTransparent
  11272.         else
  11273.             if bTst(Application^.Attr.Style,as_MoveDials) then
  11274.                 Attr.ExStyle:=Attr.ExStyle or ws_ex_MoveDial;
  11275.         edit_obj:=0;
  11276.         next_obj:=0;
  11277.         Cont:=false;
  11278.         pedt:=nil;
  11279.         BValid:=false;
  11280.         CtrlList:=nil;
  11281.         TransferBuffer:=nil;
  11282.         bsave:=true;
  11283.         d0fly:=false;
  11284.         obedflag:=false;
  11285.         IsModal:=false;
  11286.         if Parent<>nil then
  11287.             if Parent^.IsDialog then IsModal:=PDialog(Parent)^.IsModal;
  11288.         kbdh:=new(PDKey,Init(@self))
  11289.     end;
  11290.  
  11291.  
  11292. procedure TDialog.MakeWindow;
  11293.  
  11294.     begin
  11295.         Create;
  11296.         OpenWindow;
  11297.         if (IsModal) and (Application^.Err>=em_OutOfMemory) then Execute
  11298.     end;
  11299.  
  11300.  
  11301. procedure TDialog.Create;
  11302.     var r : GRECT;
  11303.         vp: INFOVSCRPtr;
  11304.  
  11305.     begin
  11306.         if Attr.Status=ws_NoWindow then
  11307.             begin
  11308.                 if not(IsModal) then IsModal:=not(bTst(Attr.ExStyle,ws_ex_Modeless));
  11309.                 if IsModal then Attr.Status:=ws_Created
  11310.                 else
  11311.                     begin
  11312.                         Application^.ChkError;
  11313.                         inherited Create;
  11314.                         if Application^.Err<em_OutOfMemory then
  11315.                             if bTst(Attr.ExStyle,ws_ex_TryModeless) then
  11316.                                 begin
  11317.                                     Application^.ChkError;
  11318.                                     Attr.Status:=ws_Created;
  11319.                                     IsModal:=true
  11320.                                 end
  11321.                     end;
  11322.                 if Attr.Status=ws_Created then
  11323.                     begin
  11324.                         with DlgTree^[ROOT] do
  11325.                             begin
  11326.                                 if bTst(Application^.Attr.Style,as_3DFlags) then ob_flags:=ob_flags or FL3DBAK
  11327.                                 else
  11328.                                     ob_flags:=ob_flags and not(FL3DBAK);
  11329.                                 if IsModal then
  11330.                                     begin
  11331.                                         ob_state:=ob_state or OUTLINED;
  11332.                                         Work.W:=ob_width+outlwidth*2;
  11333.                                         Work.H:=ob_height+outlwidth*2;
  11334.                                         wmaxw:=Work.W;
  11335.                                         wmaxh:=Work.H;
  11336.                                         Curr:=Work
  11337.                                     end
  11338.                                 else
  11339.                                     begin
  11340.                                         ob_state:=ob_state and not(OUTLINED);
  11341.                                         frwid:=ob_spec.index and $00ff0000;
  11342.                                         ob_spec.index:=ob_spec.index and $ff00ffff
  11343.                                     end
  11344.                             end;
  11345.                         r:=DRect;
  11346.                         if bTst(Attr.ExStyle,ws_ex_Center) then
  11347.                             begin
  11348.                                 if GetCookie('VSCR',longint(vp)) then
  11349.                                     if vp<>nil then
  11350.                                         with vp^ do
  11351.                                             if (cookie=$56534352) and (version>=$0100) then
  11352.                                                 begin
  11353.                                                     r.X:=x;
  11354.                                                     r.Y:=y;
  11355.                                                     r.W:=w;
  11356.                                                     r.H:=h
  11357.                                                 end;
  11358.                                 if bTst(Attr.ExStyle,ws_ex_Center2Parent) then
  11359.                                     if Parent<>nil then
  11360.                                         with Parent^ do
  11361.                                             if Attr.Status=ws_Open then
  11362.                                                 begin
  11363.                                                     r.X:=Curr.X;
  11364.                                                     r.Y:=Curr.Y;
  11365.                                                     r.W:=Curr.W;
  11366.                                                     r.H:=Curr.H
  11367.                                                 end;
  11368.                                 Curr.X:=((r.W-Curr.W) shr 1)+r.X;
  11369.                                 Curr.Y:=((r.H-Curr.H) shr 1)+r.Y;
  11370.                                 if Curr.X+Curr.W-1>DRect.X2 then Curr.X:=DRect.X2+1-Curr.W;
  11371.                                 if Curr.Y+Curr.H-1>DRect.Y2 then Curr.Y:=DRect.Y2+1-Curr.H;
  11372.                                 if Curr.X<DRect.X1 then Curr.X:=DRect.X1;
  11373.                                 if Curr.Y<DRect.Y1 then Curr.Y:=DRect.Y1;
  11374.                                 GRtoA2(Curr);
  11375.                                 if bTst(Attr.ExStyle,ws_ex_CenterOnce) then
  11376.                                     Attr.ExStyle:=Attr.ExStyle and not(ws_ex_CenterOnce)
  11377.                             end;
  11378.                         if IsModal then CreateChildren
  11379.                     end
  11380.             end
  11381.         else
  11382.             inherited Create
  11383.     end;
  11384.  
  11385.  
  11386. procedure TDialog.OpenWindow;
  11387.     var mx,my,dummy: integer;
  11388.         p          : PWindow;
  11389.         PaintInfo  : TPaintStruct;
  11390.  
  11391.     begin
  11392.         if Attr.Status=ws_Created then
  11393.             begin
  11394.                 if bTst(Attr.ExStyle,ws_ex_Popup) then
  11395.                     begin
  11396.                         graf_mkstate(mx,my,dummy,dummy);
  11397.                         Curr.X:=mx-(Curr.W shr 1);
  11398.                         Curr.Y:=my-(Curr.H shr 1);
  11399.                         if Curr.X+Curr.W-1>DRect.X2 then Curr.X:=DRect.X2+1-Curr.W;
  11400.                         if Curr.Y+Curr.H-1>DRect.Y2 then Curr.Y:=DRect.Y2+1-Curr.H;
  11401.                         if Curr.X<DRect.X1 then Curr.X:=DRect.X1;
  11402.                         if Curr.Y<DRect.Y1 then Curr.Y:=DRect.Y1;
  11403.                         GRtoA2(Curr)
  11404.                     end;
  11405.                 pedt:=nil;
  11406.                 Cont:=true;
  11407.                 if edit_obj=0 then next_obj:=Application^.ini_field(DlgTree,0)
  11408.                 else
  11409.                     begin
  11410.                         next_obj:=edit_obj;
  11411.                         edit_obj:=0
  11412.                     end;
  11413.                 TransferData(tf_SetData);
  11414.                 if IsModal then
  11415.                     begin
  11416.                         wind_update(BEG_UPDATE);
  11417.                         wind_update(BEG_MCTRL);
  11418.                         inc(Application^.DlgTop);
  11419.                         Attr.Status:=ws_Open;
  11420.                         SaveBackground;
  11421.                         if bTst(Application^.Attr.Style,as_GrowShrink) then form_box(FMD_GROW,Curr);
  11422.                         with PaintInfo do
  11423.                             begin
  11424.                                 fErase:=false;
  11425.                                 rcPaint:=Curr
  11426.                             end;
  11427.                         HideMouse;
  11428.                         UpdateDialog;
  11429.                         InitPaint;
  11430.                         Paint(PaintInfo);
  11431.                         ExitPaint;
  11432.                         ShowMouse;
  11433.                         p:=ChildList;
  11434.                         while (p<>nil) do
  11435.                             with p^ do
  11436.                                 begin
  11437.                                     OpenWindow;
  11438.                                     p:=Nxt
  11439.                                 end
  11440.                     end
  11441.                 else
  11442.                     inherited OpenWindow
  11443.             end
  11444.         else
  11445.             inherited OpenWindow
  11446.     end;
  11447.  
  11448.  
  11449. procedure TDialog.CloseWindow;
  11450.     var p    : PWindow;
  11451.         dummy: integer;
  11452.  
  11453.     begin
  11454.         p:=ChildList;
  11455.         while (p<>nil) do
  11456.             with p^ do
  11457.                 begin
  11458.                     CloseWindow;
  11459.                     p:=Nxt
  11460.                 end;
  11461.         if Attr.Status=ws_Open then
  11462.             begin
  11463.                 if edit_obj>0 then
  11464.                     begin
  11465.                         objc_edit(dummy,EDEND,Work.A2,true);
  11466.                         next_obj:=0;
  11467.                         Cont:=false;
  11468.                         pedt:=nil
  11469.                     end;
  11470.                 if IsModal then
  11471.                     begin
  11472.                         if bTst(Application^.Attr.Style,as_GrowShrink) then form_box(FMD_SHRINK,Curr);
  11473.                         RestoreBackground;
  11474.                         dec(Application^.DlgTop);
  11475.                         Attr.Status:=ws_Created;
  11476.                         wind_update(END_MCTRL);
  11477.                         wind_update(END_UPDATE)
  11478.                     end
  11479.                 else
  11480.                     inherited CloseWindow
  11481.             end
  11482.     end;
  11483.  
  11484.  
  11485. procedure TDialog.Destroy;
  11486.     var p    : PWindow;
  11487.         dummy: integer;
  11488.  
  11489.     begin
  11490.         p:=ChildList;
  11491.         while (p<>nil) do
  11492.             with p^ do
  11493.                 begin
  11494.                     Destroy;
  11495.                     p:=Nxt
  11496.                 end;
  11497.         if Attr.Status in [ws_Created,ws_Open] then
  11498.             begin
  11499.                 if IsModal then
  11500.                     begin
  11501.                         CloseWindow;
  11502.                         IsModal:=false;
  11503.                         Attr.Status:=ws_NoWindow
  11504.                     end
  11505.                 else
  11506.                     begin
  11507.                         with DlgTree^[ROOT] do
  11508.                             ob_spec.index:=ob_spec.index or frwid;
  11509.                         inherited Destroy
  11510.                     end
  11511.             end
  11512.     end;
  11513.  
  11514.  
  11515. procedure TDialog.Paint(var PaintInfo: TPaintStruct);
  11516.     var dummy: integer;
  11517.  
  11518.     begin
  11519.         with PaintInfo.rcPaint do objc_draw(DlgTree,ROOT,MAX_DEPTH,X,Y,W,H);
  11520.         if (next_obj>0) and (edit_obj<>next_obj) then
  11521.             begin
  11522.                 edit_obj:=next_obj;
  11523.                 next_obj:=0;
  11524.                 CallChanged(edit_obj,false,true,false);
  11525.                 objc_edit(dummy,EDINIT,PaintInfo.rcPaint.A2,false)
  11526.             end
  11527.         else
  11528.             if edit_obj>0 then
  11529.                 objc_edit(dummy,EDDRAW,PaintInfo.rcPaint.A2,false)
  11530.     end;
  11531.  
  11532.  
  11533. procedure TDialog.ObjcPaint(Indx: integer; Lazy: boolean);
  11534.     label _weiter;
  11535.  
  11536.     var box    : GRECT;
  11537.         visible: boolean;
  11538.  
  11539.     begin
  11540.         if Attr.Status=ws_Open then
  11541.             if not(IsIconified) then
  11542.                 begin
  11543.                     if IsModal then
  11544.                         begin
  11545.                             HideMouse;
  11546.                             with DRect do objc_draw(DlgTree,Indx,MAX_DEPTH,X,Y,W,H);
  11547.                             ShowMouse
  11548.                         end
  11549.                     else
  11550.                         begin
  11551.                             if Lazy then
  11552.                                 if agi.WindUpdate then
  11553.                                     begin
  11554.                                         if wind_update(TEST_BEG_UPDATE)=0 then exit
  11555.                                         else
  11556.                                             goto _weiter
  11557.                                     end;
  11558.                             wind_update(BEG_UPDATE);
  11559.                             _weiter:
  11560.                             HideMouse;
  11561.                             visible:=FirstWorkRect(box);
  11562.                             while visible do
  11563.                                 begin
  11564.                                     with box do objc_draw(DlgTree,Indx,MAX_DEPTH,X,Y,W,H);
  11565.                                     visible:=NextWorkRect(box)
  11566.                                 end;
  11567.                             ShowMouse;
  11568.                             wind_update(END_UPDATE)
  11569.                         end
  11570.                 end
  11571.     end;
  11572.  
  11573.  
  11574. procedure TDialog.GetWorkMax(var maxX,maxY: integer);
  11575.  
  11576.     begin
  11577.         maxX:=wmaxw;
  11578.         maxY:=wmaxh
  11579.     end;
  11580.  
  11581.  
  11582. procedure TDialog.WMClosed;
  11583.     var valid   : boolean;
  11584.         tst,indx: integer;
  11585.         p       : PControl;
  11586.  
  11587.     begin
  11588.         if bTst(Class.Style,cs_CancelOnClose) then tst:=id_Cancel
  11589.         else
  11590.             tst:=id_OK;
  11591.         p:=CtrlList;
  11592.         indx:=-1;
  11593.         while p<>nil do
  11594.             begin
  11595.                 if p^.TestID(tst) then
  11596.                     begin
  11597.                         indx:=p^.ObjIndx;
  11598.                         break
  11599.                     end;
  11600.                 p:=p^.Nxt
  11601.             end;
  11602.         if indx>=0 then
  11603.             begin
  11604.                 if p^.GetState<>bf_Enabled then exit;
  11605.                 if bTst(DlgTree^[indx].ob_flags,SELECTABLE) then
  11606.                     begin
  11607.                         DlgTree^[indx].ob_state:=DlgTree^[indx].ob_state or SELECTED;
  11608.                         ObjcPaint(indx,false)
  11609.                     end
  11610.             end;
  11611.         valid:=false;
  11612.         if CanClose then
  11613.             begin
  11614.                 if tst=id_Cancel then valid:=Cancel
  11615.                 else
  11616.                     valid:=OK
  11617.             end;
  11618.         if valid then
  11619.             begin
  11620.                 if indx>=0 then
  11621.                     DlgTree^[indx].ob_state:=DlgTree^[indx].ob_state and not(SELECTED);
  11622.                 Destroy;
  11623.                 if bTst(Class.Style,cs_QuitOnClose) then
  11624.                     with Application^ do if ChkError>=em_OutOfMemory then Quit
  11625.             end
  11626.         else
  11627.             if indx>=0 then
  11628.                 begin
  11629.                     DlgTree^[indx].ob_state:=DlgTree^[indx].ob_state and not(SELECTED);
  11630.                     if bTst(DlgTree^[indx].ob_flags,SELECTABLE) then ObjcPaint(indx,false)
  11631.                 end
  11632.     end;
  11633.  
  11634.  
  11635. procedure TDialog.WMButton(mX,mY,BStat,KStat,Clicks: integer);
  11636.     label _fly;
  11637.  
  11638.     var nx,dummy,d2: integer;
  11639.         valid      : boolean;
  11640.         pct        : PControl;
  11641.         pinfo      : TPaintStruct;
  11642.         ltmove     : function(d1,d2: pointer; d3,d4,d5: longint; tree: PTree; x,y: integer): integer;
  11643.  
  11644.     begin
  11645.         nx:=objc_find(DlgTree,ROOT,MAX_DEPTH,mX,mY);
  11646.         if BStat=2 then
  11647.             begin
  11648.                 if Clicks=2 then
  11649.                     begin
  11650.                         Top;
  11651.                         exit
  11652.                     end
  11653.                 else
  11654.                     if nx>=0 then
  11655.                         begin
  11656.                             valid:=false;
  11657.                             pct:=CtrlList;
  11658.                             while (pct<>nil) do
  11659.                                 with pct^ do
  11660.                                     begin
  11661.                                         if TestIndex(nx) then
  11662.                                             if IsHelpAvailable then valid:=true;
  11663.                                         pct:=Nxt
  11664.                                     end;
  11665.                             if valid then
  11666.                                 if kbdh<>nil then kbdh^.TestKey(0,S_Help);
  11667.                             exit
  11668.                         end
  11669.             end;
  11670.         if nx=-1 then
  11671.             begin
  11672.                 if IsModal then
  11673.                     begin
  11674.                         if BStat=1 then
  11675.                             begin
  11676.                                 if ltmf<>nil then
  11677.                                     if ltmf^.version>=$0115 then
  11678.                                         begin
  11679.                                             ltmove:=ltmf^.di_moveto;
  11680.                                             ltmove(nil,nil,0,0,0,DlgTree,mX,mY);
  11681.                                             Curr.X:=DlgTree^[ROOT].ob_x-outlwidth;
  11682.                                             Curr.Y:=DlgTree^[ROOT].ob_y-outlwidth;
  11683.                                             GRtoA2(Curr);
  11684.                                             UpdateDialog;
  11685.                                             exit
  11686.                                         end;
  11687.                                 HideMouse;
  11688.                                 RestoreBackground;
  11689.                                 dummy:=Curr.X;
  11690.                                 d2:=Curr.Y;
  11691.                                 Curr.X:=mX-(DlgTree^[ROOT].ob_width shr 1);
  11692.                                 Curr.Y:=mY-(DlgTree^[ROOT].ob_height shr 1);
  11693.                                 if Curr.X+Curr.W-1>DRect.X2 then Curr.X:=DRect.X2+1-Curr.W;
  11694.                                 if Curr.Y+Curr.H-1>DRect.Y2 then Curr.Y:=DRect.Y2+1-Curr.H;
  11695.                                 if Curr.X<DRect.X then Curr.X:=DRect.X;
  11696.                                 if Curr.Y<DRect.Y then Curr.Y:=DRect.Y;
  11697.                                 GRtoA2(Curr);
  11698.                                 graf_movebox(Curr.W,Curr.H,dummy,d2,Curr.X,Curr.Y);
  11699.                                 SaveBackground;
  11700.                                 with pinfo do
  11701.                                     begin
  11702.                                         fErase:=false;
  11703.                                         rcPaint:=Curr
  11704.                                     end;
  11705.                                 UpdateDialog;
  11706.                                 InitPaint;
  11707.                                 Paint(pinfo);
  11708.                                 ExitPaint;
  11709.                                 ShowMouse
  11710.                             end;
  11711.                         Bconout(2,BEL)
  11712.                     end
  11713.                 else
  11714.                     inherited WMButton(mX,mY,BStat,KStat,Clicks);
  11715.                 exit
  11716.             end;
  11717.         if BStat<>1 then exit;
  11718.         if DlgTree^[nx].ob_flags and (SELECTABLE or DEFAULT or F_EXIT or EDITABLE or RBUTTON or TOUCHEXIT)=0 then
  11719.             begin
  11720.                 _fly:
  11721.                 if d0fly and (Clicks=1) then MoveDial(mX,mY);
  11722.                 exit
  11723.             end;
  11724.         if not(bTst(DlgTree^[nx].ob_state,DISABLED)) then
  11725.             begin
  11726.                 next_obj:=nx;
  11727.                 Cont:=Application^.form_button(@self,next_obj,Clicks,next_obj);
  11728.                 if not(Cont) then
  11729.                     begin
  11730.                         nx:=next_obj;
  11731.                         next_obj:=0;
  11732.                         CallChanged(word(nx) and $7fff,bTst(word(nx),$8000),false,false);
  11733.                         EndDlg(integer(word(nx) and $7fff),bTst(word(nx),$8000))
  11734.                     end
  11735.                 else
  11736.                     begin
  11737.                         if (next_obj>0) and (edit_obj<>next_obj) then
  11738.                             begin
  11739.                                 objc_edit(dummy,EDEND,Work.A2,true);
  11740.                                 edit_obj:=next_obj;
  11741.                                 next_obj:=0;
  11742.                                 CallChanged(edit_obj,false,true,false);
  11743.                                 objc_edit(dummy,EDINIT,Work.A2,true)
  11744.                             end
  11745.                         else
  11746.                             begin
  11747.                                 if next_obj<=0 then CallChanged(nx,false,false,true)
  11748.                                 else
  11749.                                     objc_edit(mX,EDIDX,Work.A2,true)
  11750.                             end
  11751.                     end
  11752.             end
  11753.         else
  11754.             goto _fly
  11755.     end;
  11756.  
  11757.  
  11758. procedure TDialog.Execute;
  11759.     var evnt,mx,my,mb,ks,kr,br: integer;
  11760.         pipe                  : Pipearray;
  11761.         gmnr                  : HCursor;
  11762.         gmform                : MFORM;
  11763.  
  11764.     begin
  11765.         if not(IsModal) then exit;
  11766.         gmnr:=GP.mnr;
  11767.         gmform:=GP.mform;
  11768.         if Class.hCursor>id_No then
  11769.             begin
  11770.                 if Class.hCursor>$7fff then graf_mouse(MFORCE or USER_DEF,pointer(Class.hCursor))
  11771.                 else
  11772.                     graf_mouse(MFORCE or Class.hCursor,nil)
  11773.             end
  11774.         else
  11775.             graf_mouse(MFORCE or ARROW,nil);
  11776.         if bTst(Attr.ExStyle,ws_ex_MoveDial) then d0fly:=true;
  11777.         while Cont do
  11778.             begin
  11779.                 if (next_obj>0) and (edit_obj<>next_obj) then
  11780.                     begin
  11781.                         edit_obj:=next_obj;
  11782.                         next_obj:=0;
  11783.                         CallChanged(edit_obj,false,true,false);
  11784.                         objc_edit(evnt,EDINIT,Work.A2,false)
  11785.                     end;
  11786.                 evnt:=evnt_multi(MU_KEYBD or MU_BUTTON,258,3,0,0,0,0,0,0,0,0,0,0,0,pipe,0,0,mx,my,mb,ks,kr,br);
  11787.                 if bTst(evnt,MU_KEYBD) then
  11788.                     if kbdh<>nil then kbdh^.TestKey(ks,kr);
  11789.                 if bTst(evnt,MU_BUTTON) then WMButton(mx,my,mb,ks,br);
  11790.                 if (next_obj>0) and (next_obj<>edit_obj) then objc_edit(evnt,EDEND,Work.A2,false)
  11791.             end;
  11792.         d0fly:=false;
  11793.         graf_mouse(gmnr,@gmform)
  11794.     end;
  11795.  
  11796.  
  11797. procedure TDialog.EndDlg(Indx: integer; DblClick: boolean);
  11798.     label _cont;
  11799.  
  11800.     var p          : PControl;
  11801.         valid,found: boolean;
  11802.  
  11803.     begin
  11804.         Result:=Indx;
  11805.         found:=false;
  11806.         valid:=true;
  11807.         p:=CtrlList;
  11808.         while (p<>nil) do
  11809.             begin
  11810.                 if p^.TestIndex(Indx) then
  11811.                     begin
  11812.                         if p^.TestID(id_OK) then
  11813.                             begin
  11814.                                 found:=true;
  11815.                                 valid:=OK
  11816.                             end;
  11817.                         if p^.TestID(id_Cancel) then
  11818.                             begin
  11819.                                 found:=true;
  11820.                                 valid:=Cancel
  11821.                             end;
  11822.                         if p^.TestID(id_Help) then
  11823.                             begin
  11824.                                 found:=true;
  11825.                                 valid:=Help
  11826.                             end;
  11827.                         if p^.TestID(id_Undo) then
  11828.                             begin
  11829.                                 found:=true;
  11830.                                 valid:=Undo
  11831.                             end;
  11832.                         if p^.TestID(id_Esc) then
  11833.                             begin
  11834.                                 found:=true;
  11835.                                 valid:=Esc
  11836.                             end;
  11837.                         if p^.TestID(id_NoExit) then
  11838.                             begin
  11839.                                 found:=true;
  11840.                                 valid:=false
  11841.                             end
  11842.                     end;
  11843.                 p:=p^.Nxt
  11844.             end;
  11845.         if not(found) then valid:=ExitDlg(Indx);
  11846.         if not(valid) then goto _cont;
  11847.         if CanClose then
  11848.             begin
  11849.                 DlgTree^[Indx].ob_state:=DlgTree^[Indx].ob_state and not(SELECTED);
  11850.                 Destroy
  11851.             end
  11852.         else
  11853.             begin
  11854.                 _cont:
  11855.                 Cont:=true;
  11856.                 DlgTree^[Indx].ob_state:=DlgTree^[Indx].ob_state and not(SELECTED);
  11857.                 if bTst(DlgTree^[Indx].ob_flags,SELECTABLE) then ObjcPaint(Indx,false)
  11858.             end
  11859.     end;
  11860.  
  11861.  
  11862. procedure TDialog.TransferData(Direction: word);
  11863.     var p : PControl;
  11864.         tp: pointer;
  11865.  
  11866.     begin
  11867.         if TransferBuffer<>nil then
  11868.             begin
  11869.                 p:=CtrlList;
  11870.                 tp:=TransferBuffer;
  11871.                 while p<>nil do
  11872.                     with p^ do
  11873.                         begin
  11874.                             if IsFlagSet(wb_Transfer) then
  11875.                                 inc(longint(tp),Transfer(tp,Direction));
  11876.                             p:=Nxt
  11877.                         end
  11878.             end
  11879.     end;
  11880.  
  11881.  
  11882. function TDialog.ExitDlg(AnIndx: integer): boolean;
  11883.  
  11884.     begin
  11885.         ExitDlg:=true
  11886.     end;
  11887.  
  11888.  
  11889. function TDialog.OK: boolean;
  11890.     var vald: boolean;
  11891.         p   : PControl;
  11892.  
  11893.     begin
  11894.         vald:=true;
  11895.         p:=CtrlList;
  11896.         while (p<>nil) and vald do
  11897.             begin
  11898.                 if bTst(p^.Style,cs_Edit) then vald:=PEdit(p)^.CanClose;
  11899.                 p:=p^.Nxt
  11900.             end;
  11901.         if vald then TransferData(tf_GetData);
  11902.         OK:=vald
  11903.     end;
  11904.  
  11905.  
  11906. function TDialog.Cancel: boolean;
  11907.  
  11908.     begin
  11909.         Cancel:=true
  11910.     end;
  11911.  
  11912.  
  11913. function TDialog.Help: boolean;
  11914.  
  11915.     begin
  11916.         Help:=false
  11917.     end;
  11918.  
  11919.  
  11920. function TDialog.Undo: boolean;
  11921.  
  11922.     begin
  11923.         Undo:=false
  11924.     end;
  11925.  
  11926.  
  11927. function TDialog.Esc: boolean;
  11928.  
  11929.     begin
  11930.         Esc:=false
  11931.     end;
  11932.  
  11933.  
  11934. procedure TDialog.Cut;
  11935.  
  11936.     begin
  11937.         if pedt<>nil then pedt^.Cut
  11938.     end;
  11939.  
  11940.  
  11941. procedure TDialog.Copy;
  11942.  
  11943.     begin
  11944.         if pedt<>nil then pedt^.Copy
  11945.     end;
  11946.  
  11947.  
  11948. procedure TDialog.Paste;
  11949.  
  11950.     begin
  11951.         if pedt<>nil then pedt^.Paste
  11952.     end;
  11953.  
  11954.  
  11955. procedure TDialog.Delete;
  11956.  
  11957.     begin
  11958.         if kbdh<>nil then kbdh^.TestKey(K_NORMAL,S_Delete)
  11959.     end;
  11960.  
  11961.  
  11962. function TDialog.FirstThat(Test: PIterationFunc): PControl;
  11963.     var p : PControl;
  11964.         cl: IterationFunc;
  11965.  
  11966.     begin
  11967.         FirstThat:=nil;
  11968.         p:=CtrlList;
  11969.         cl:=IterationFunc(Test);
  11970.         while p<>nil do
  11971.             begin
  11972.                 if cl(p) then
  11973.                     begin
  11974.                         FirstThat:=p;
  11975.                         exit
  11976.                     end;
  11977.                 p:=p^.Nxt
  11978.             end
  11979.     end;
  11980.  
  11981.  
  11982. procedure TDialog.ForEach(Action: PIterationProc);
  11983.     var p : PControl;
  11984.         cl: IterationProc;
  11985.  
  11986.     begin
  11987.         p:=CtrlList;
  11988.         cl:=IterationProc(Action);
  11989.         while p<>nil do
  11990.             begin
  11991.                 cl(p);
  11992.                 p:=p^.Nxt
  11993.             end
  11994.     end;
  11995.  
  11996.  
  11997. procedure TDialog.InitFocus;
  11998.     var dummy: integer;
  11999.  
  12000.     begin
  12001.         if edit_obj>0 then objc_edit(dummy,EDEND,Work.A2,true);
  12002.         edit_obj:=0;
  12003.         next_obj:=Application^.ini_field(DlgTree,0);
  12004.         if next_obj>0 then
  12005.             begin
  12006.                 edit_obj:=next_obj;
  12007.                 next_obj:=0;
  12008.                 CallChanged(edit_obj,false,true,false);
  12009.                 objc_edit(dummy,EDINIT,Work.A2,true)
  12010.             end
  12011.     end;
  12012.  
  12013.  
  12014. procedure TDialog.SetFocus(Obj: integer);
  12015.     var dummy: integer;
  12016.  
  12017.     begin
  12018.         if Obj>0 then
  12019.             begin
  12020.                 if (DlgTree^[Obj].ob_flags and (EDITABLE or HIDETREE)=EDITABLE) and not(bTst(DlgTree^[Obj].ob_state,DISABLED)) then
  12021.                     begin
  12022.                         if edit_obj>0 then objc_edit(dummy,EDEND,Work.A2,true);
  12023.                         edit_obj:=Obj;
  12024.                         next_obj:=0;
  12025.                         CallChanged(edit_obj,false,true,false);
  12026.                         objc_edit(dummy,EDINIT,Work.A2,true)
  12027.                     end
  12028.                 else
  12029.                     InitFocus
  12030.             end
  12031.         else
  12032.             InitFocus
  12033.     end;
  12034.  
  12035.  
  12036. function TDialog.GetFocus: integer;
  12037.  
  12038.     begin
  12039.         if edit_obj>0 then GetFocus:=edit_obj
  12040.         else
  12041.             GetFocus:=id_No
  12042.     end;
  12043.  
  12044.  
  12045. procedure TDialog.CallChanged(Indx: integer; dclk,edt,push: boolean);
  12046.     var p: PControl;
  12047.  
  12048.     begin
  12049.         p:=CtrlList;
  12050.         if edt then pedt:=nil;
  12051.         while (p<>nil) do
  12052.             begin
  12053.                 if p^.TestIndex(Indx) then
  12054.                     begin
  12055.                         if edt then pedt:=PEdit(p);
  12056.                         if not(bTst(p^.Style,cs_PushButton)) or not(push) then p^.Changed(Indx,dclk)
  12057.                         else
  12058.                             if bTst(p^.ObjAddr^.ob_state,SELECTED) then p^.Changed(Indx,dclk);
  12059.                         exit
  12060.                     end
  12061.                 else
  12062.                     p:=p^.Nxt
  12063.             end
  12064.     end;
  12065.  
  12066.  
  12067.     { private }
  12068.  
  12069.  
  12070. procedure TDialog.MoveDial(mX,mY: integer);
  12071.     var nx,ny,w,h: integer;
  12072.         pinfo    : TPaintStruct;
  12073.         fmf      : word;
  12074.         ltfly    : procedure(d1,d2: pointer; d3,d4,d5: longint; tree: PTree);
  12075.  
  12076.     begin
  12077.         if ltmf<>nil then
  12078.             begin
  12079.                 ltfly:=ltmf^.di_fly;
  12080.                 ltfly(nil,nil,0,0,0,DlgTree);
  12081.                 Curr.X:=DlgTree^[ROOT].ob_x-outlwidth;
  12082.                 Curr.Y:=DlgTree^[ROOT].ob_y-outlwidth;
  12083.                 GRtoA2(Curr);
  12084.                 UpdateDialog;
  12085.                 exit
  12086.             end;
  12087.         if bTst(Attr.ExStyle,ws_ex_MoveTransparent) then RestoreBackground;
  12088.         fmf:=FLAT_HAND;
  12089.         if Application^.MultiTOS then fmf:=fmf or MFORCE;
  12090.         gem.graf_mouse(fmf,nil);
  12091.         graf_dragbox(Curr.W,Curr.H,Curr.X,Curr.Y,DRect.X,DRect.Y,DRect.W+Curr.X+Curr.W-mX-1,DRect.H+Curr.Y+Curr.H-mY-1,nx,ny);
  12092.         HideMouse;
  12093.         if (Curr.X<>nx) or (Curr.Y<>ny) or bTst(Attr.ExStyle,ws_ex_MoveTransparent) then
  12094.             begin
  12095.                 if not(bTst(Attr.ExStyle,ws_ex_MoveTransparent)) then RestoreBackground;
  12096.                 Curr.X:=nx;
  12097.                 Curr.Y:=ny;
  12098.                 GRtoA2(Curr);
  12099.                 SaveBackground;
  12100.                 with pinfo do
  12101.                     begin
  12102.                         fErase:=false;
  12103.                         rcPaint:=Curr
  12104.                     end;
  12105.                 UpdateDialog;
  12106.                 InitPaint;
  12107.                 Paint(pinfo);
  12108.                 ExitPaint
  12109.             end;
  12110.         gem.graf_mouse(GP.mnr,@GP.mform);
  12111.         ShowMouse
  12112.     end;
  12113.  
  12114.  
  12115. procedure TDialog.SaveBackground;
  12116.     var box : GRECT;
  12117.         scrn: MFDB;
  12118.         pxy : ARRAY_8;
  12119.  
  12120.     begin
  12121.         if (IsModal) and (bsave) then
  12122.             begin
  12123.                 bsave:=false;
  12124.                 box:=Curr;
  12125.                 if rc_intersect(DRect,box) then
  12126.                     begin
  12127.                         if ltmf<>nil then
  12128.                             begin
  12129.                                 form_dial(FMD_START,0,0,0,0,box.X,box.Y,box.W,box.H);
  12130.                                 exit
  12131.                             end;
  12132.                         with BackGr do
  12133.                             begin
  12134.                                 fd_w:=box.W;
  12135.                                 fd_h:=box.H;
  12136.                                 fd_stand:=FF_DEVSPEC;
  12137.                                 fd_wdwidth:=(fd_w+15) shr 4;
  12138.                                 fd_nplanes:=Application^.Attr.Planes;
  12139.                                 BLen:=(longint(fd_wdwidth)*longint(fd_h)*longint(fd_nplanes)) shl 1
  12140.                             end;
  12141.                         if not(bTst(Class.Style,cs_SaveBits)) then BackGr.fd_addr:=nil
  12142.                         else
  12143.                             getmem(BackGr.fd_addr,BLen);
  12144.                         if BackGr.fd_addr=nil then
  12145.                             form_dial(FMD_START,0,0,0,0,box.X,box.Y,box.W,box.H)
  12146.                         else
  12147.                             begin
  12148.                                 scrn.fd_addr:=nil;
  12149.                                 pxy[0]:=box.X;
  12150.                                 pxy[1]:=box.Y;
  12151.                                 pxy[2]:=box.X+box.W-1;
  12152.                                 pxy[3]:=box.Y+box.H-1;
  12153.                                 pxy[4]:=0;
  12154.                                 pxy[5]:=0;
  12155.                                 pxy[6]:=BackGr.fd_w-1;
  12156.                                 pxy[7]:=BackGr.fd_h-1;
  12157.                                 BValid:=true;
  12158.                                 HideMouse;
  12159.                                 vro_cpyfm(vdiHandle,S_ONLY,pxy,scrn,BackGr);
  12160.                                 ShowMouse
  12161.                             end
  12162.                     end
  12163.             end
  12164.     end;
  12165.  
  12166.  
  12167. procedure TDialog.RestoreBackground;
  12168.     var box  : GRECT;
  12169.         scrn : MFDB;
  12170.         pxy  : ARRAY_8;
  12171.  
  12172.     begin
  12173.         if (IsModal) and not(bsave) then
  12174.             begin
  12175.                 bsave:=true;
  12176.                 box:=Curr;
  12177.                 if rc_intersect(DRect,box) then
  12178.                     begin
  12179.                         if BValid then
  12180.                             begin
  12181.                                 scrn.fd_addr:=nil;
  12182.                                 pxy[0]:=0;
  12183.                                 pxy[1]:=0;
  12184.                                 pxy[2]:=BackGr.fd_w-1;
  12185.                                 pxy[3]:=BackGr.fd_h-1;
  12186.                                 pxy[4]:=box.X;
  12187.                                 pxy[5]:=box.Y;
  12188.                                 pxy[6]:=box.X+box.W-1;
  12189.                                 pxy[7]:=box.Y+box.H-1;
  12190.                                 BValid:=false;
  12191.                                 HideMouse;
  12192.                                 vro_cpyfm(vdiHandle,S_ONLY,pxy,BackGr,scrn);
  12193.                                 ShowMouse;
  12194.                                 freemem(BackGr.fd_addr,BLen)
  12195.                             end
  12196.                         else
  12197.                             begin
  12198.                                 form_dial(FMD_FINISH,0,0,0,0,box.X,box.Y,box.W,box.H);
  12199.                                 if ltmf=nil then Application^.RestoreModalDialog(Parent)
  12200.                             end
  12201.                     end
  12202.             end
  12203.     end;
  12204.  
  12205.  
  12206. function TDialog.objc_edit(var ob_edchar: integer; ob_edkind: integer; clp: ARRAY_4; cclp: boolean): integer;
  12207.     label _delline,_edidx;
  12208.  
  12209.     var typ,ox,oy,toffs,q,chw,vlen: integer;
  12210.         pted                      : TEDINFOPtr;
  12211.         thechar,vchar             : char;
  12212.  
  12213.     function ValidChar(mask: char): boolean;
  12214.  
  12215.         begin
  12216.             if pedt<>nil then
  12217.                 if bTst(pedt^.Style,es_ASCIIOnly) then
  12218.                     if not(thechar in [' '..'~']) then
  12219.                         begin
  12220.                             ValidChar:=false;
  12221.                             exit
  12222.                         end;
  12223.             ValidChar:=false;
  12224.             case mask of
  12225.                 'X': ValidChar:=true;
  12226.                 '9': if thechar in ['0'..'9'] then ValidChar:=true;
  12227.                 'A': if upcase(thechar) in [' ','A'..'Z'] then
  12228.                              begin
  12229.                                  ValidChar:=true;
  12230.                                  thechar:=upcase(thechar)
  12231.                              end;
  12232.                 'a': if thechar in [' ','A'..'Z','a'..'z'] then ValidChar:=true;
  12233.                 'N': if upcase(thechar) in [' ','0'..'9','A'..'Z'] then
  12234.                              begin
  12235.                                  ValidChar:=true;
  12236.                                  thechar:=upcase(thechar)
  12237.                              end;
  12238.                 'n': if thechar in [' ','0'..'9','A'..'Z','a'..'z'] then ValidChar:=true;
  12239.                 'F': if thechar in ['!'..'-','0'..'9',';'..'[',']'..'~'] then ValidChar:=true;
  12240.                 'f': if thechar in ['!'..')','+'..'-',';'..'>','0'..'9','@'..'[',']'..'~'] then ValidChar:=true;
  12241.                 'P': if thechar in ['!'..'.','0'..'~'] then ValidChar:=true;
  12242.                 'p': if thechar in ['!'..')','+'..'.','0'..'>','@'..'~'] then ValidChar:=true;
  12243.                 'H': if upcase(thechar) in ['0'..'9','A'..'F'] then ValidChar:=true;
  12244.                 'D': if thechar in ['0'..'9','+','-',',','.'] then ValidChar:=true;
  12245.                 '+': if (thechar='+') or (thechar='-') then ValidChar:=true
  12246.             end
  12247.         end;
  12248.  
  12249.     function getmaxidx: integer;
  12250.  
  12251.         begin
  12252.             getmaxidx:=StrLen(pted^.te_ptext)
  12253.         end;
  12254.  
  12255.     procedure eprint(ce: boolean);
  12256.         var ot: integer;
  12257.  
  12258.         begin
  12259.             if ce then if pedt<>nil then pedt^.Edit;
  12260.             if idx>getmaxidx then
  12261.                 begin
  12262.                     idx:=getmaxidx;
  12263.                     if pedt<>nil then pedt^.EdIdx:=idx
  12264.                 end;
  12265.             ot:=DlgTree^[edit_obj].ob_type;
  12266.             DlgTree^[edit_obj].ob_type:=G_FTEXT;
  12267.             ObjcPaint(edit_obj,false);
  12268.             DlgTree^[edit_obj].ob_type:=ot;
  12269.             ob_edchar:=0
  12270.         end;
  12271.  
  12272.     procedure cursor;
  12273.         var box    : GRECT;
  12274.             visible: boolean;
  12275.  
  12276.         procedure cursor_prnt;
  12277.             var anz: integer;
  12278.  
  12279.             begin
  12280.                 q:=toffs;
  12281.                 anz:=0;
  12282.                 while anz<idx do
  12283.                     begin
  12284.                         if PChar(longint(pted^.te_ptmplt)+q)^='_' then inc(anz);
  12285.                         inc(q)
  12286.                     end;
  12287.                 if idx<pted^.te_txtlen-1 then
  12288.                     while PChar(longint(pted^.te_ptmplt)+q)^<>'_' do inc(q);
  12289.                 gem.vswr_mode(vdiHandle,MD_XOR);
  12290.                 pxya[0]:=ox+(q-toffs)*chw;
  12291.                 pxya[1]:=oy;
  12292.                 pxya[2]:=pxya[0];
  12293.                 pxya[3]:=oy+SysInfo.SFHeight+2;
  12294.                 HideMouse;
  12295.                 v_pline(vdiHandle,2,pxya);
  12296.                 ShowMouse;
  12297.                 gem.vswr_mode(vdiHandle,MD_REPLACE)
  12298.             end;
  12299.  
  12300.         begin
  12301.             if not(cclp) or IsModal then cursor_prnt
  12302.             else
  12303.                 begin
  12304.                     visible:=FirstWorkRect(box);
  12305.                     while visible do
  12306.                         begin
  12307.                             vs_clip(vdiHandle,CLIP_ON,box.A2);
  12308.                             cursor_prnt;
  12309.                             visible:=NextWorkRect(box)
  12310.                         end;
  12311.                     vs_clip(vdiHandle,CLIP_ON,DRect.A2)
  12312.                 end
  12313.         end;
  12314.  
  12315.     begin
  12316.         typ:=DlgTree^[edit_obj].ob_type and $ff;
  12317.         if (typ=G_FTEXT) or (typ=G_FBOXTEXT) then
  12318.             begin
  12319.                 objc_edit:=1;
  12320.                 pted:=DlgTree^[edit_obj].ob_spec.ted_info;
  12321.                 objc_offset(DlgTree,edit_obj,ox,oy);
  12322.                 toffs:=0;
  12323.                 inc(oy,((DlgTree^[edit_obj].ob_height-SysInfo.SFHeight) shr 1)-1);
  12324.                 while (PChar(longint(pted^.te_ptmplt)+toffs)^<>'_') and (PChar(longint(pted^.te_ptmplt)+toffs)^<>#0) do inc(toffs);
  12325.                 if pted^.te_font=SMALL then chw:=6
  12326.                     else chw:=SysInfo.SFWidth;
  12327.                 inc(ox,toffs*chw);
  12328.                 case pted^.te_just of
  12329.                     TE_RIGHT: ox:=ox+DlgTree^[edit_obj].ob_width-(pted^.te_tmplen-1)*chw;
  12330.                     TE_CNTR: inc(ox,(DlgTree^[edit_obj].ob_width+1-(pted^.te_tmplen-1)*chw) shr 1)
  12331.                 end;
  12332.                 InitVWrk;
  12333.                 vs_clip(vdiHandle,CLIP_ON,clp);
  12334.                 case ob_edkind of
  12335.                 EDINIT: begin
  12336.                                     if PChar(pted^.te_ptext)^='@' then PChar(pted^.te_ptext)^:=#0;
  12337.                                     if pedt<>nil then idx:=pedt^.EdIdx
  12338.                                         else idx:=-1;
  12339.                                     if (idx<0) or (idx>getmaxidx) then
  12340.                                         begin
  12341.                                             idx:=getmaxidx;
  12342.                                             if pedt<>nil then pedt^.EdIdx:=idx
  12343.                                         end;
  12344.                                     cursor
  12345.                                 end;
  12346.                 EDCHAR: begin
  12347.                                     cursor;
  12348.                                     obedflag:=true;
  12349.                                     _delline:
  12350.                                     case ob_edchar of
  12351.                                         S_Esc: begin
  12352.                                                          PChar(pted^.te_ptext)^:=#0;
  12353.                                                          idx:=0;
  12354.                                                          if pedt<>nil then pedt^.EdIdx:=0;
  12355.                                                          eprint(true)
  12356.                                                      end;
  12357.                                         BackSpace: begin
  12358.                                                                  if idx>0 then
  12359.                                                                      begin
  12360.                                                                          dec(idx);
  12361.                                                                          if pedt<>nil then pedt^.EdIdx:=idx;
  12362.                                                                          typ:=getmaxidx-1;
  12363.                                                                          if typ>idx then
  12364.                                                                              for q:=idx to typ-1 do
  12365.                                                                                  PChar(longint(pted^.te_ptext)+q)^:=PChar(longint(pted^.te_ptext)+q+1)^;
  12366.                                                                          PChar(longint(pted^.te_ptext)+typ)^:=#0;
  12367.                                                                          eprint(true)
  12368.                                                                      end;
  12369.                                                                  ob_edchar:=0
  12370.                                                              end;
  12371.                                         S_Delete: begin
  12372.                                                                 if (Kbshift(-1) and K_SHIFT)>0 then
  12373.                                                                     begin
  12374.                                                                         ob_edchar:=S_Esc;
  12375.                                                                         goto _delline
  12376.                                                                     end;
  12377.                                                                 if idx<getmaxidx then
  12378.                                                                     begin
  12379.                                                                         typ:=getmaxidx-1;
  12380.                                                                         if typ>idx then
  12381.                                                                             for q:=idx to typ-1 do
  12382.                                                                                 PChar(longint(pted^.te_ptext)+q)^:=PChar(longint(pted^.te_ptext)+q+1)^;
  12383.                                                                         PChar(longint(pted^.te_ptext)+typ)^:=#0;
  12384.                                                                         eprint(true)
  12385.                                                                     end;
  12386.                                                                 ob_edchar:=0
  12387.                                                             end;
  12388.                                         Cur_Left: begin
  12389.                                                                 if idx>0 then
  12390.                                                                     begin
  12391.                                                                         dec(idx);
  12392.                                                                         if pedt<>nil then pedt^.EdIdx:=idx
  12393.                                                                     end;
  12394.                                                                 ob_edchar:=0
  12395.                                                             end;
  12396.                                         Cur_Right: begin
  12397.                                                                  if idx<getmaxidx then
  12398.                                                                      begin
  12399.                                                                          inc(idx);
  12400.                                                                          if pedt<>nil then pedt^.EdIdx:=idx
  12401.                                                                      end;
  12402.                                                                  ob_edchar:=0
  12403.                                                              end;
  12404.                                         Shift_CL,$7300: begin
  12405.                                                                             idx:=0;
  12406.                                                                             if pedt<>nil then pedt^.EdIdx:=idx;
  12407.                                                                             ob_edchar:=0
  12408.                                                                         end;
  12409.                                         Shift_CR,$7400: begin
  12410.                                                                             idx:=getmaxidx;
  12411.                                                                             if pedt<>nil then pedt^.EdIdx:=idx;
  12412.                                                                             ob_edchar:=0
  12413.                                                                         end;
  12414.                                         S_Undo: begin
  12415.                                                             if pedt<>nil then
  12416.                                                                 if pedt^.CanUndo then
  12417.                                                                     begin
  12418.                                                                         pedt^.Undo;
  12419.                                                                         eprint(false)
  12420.                                                                     end;
  12421.                                                             ob_edchar:=0
  12422.                                                         end
  12423.                                     else
  12424.                                         if idx<pted^.te_txtlen-1 then typ:=idx
  12425.                                         else
  12426.                                             typ:=pted^.te_txtlen-2;
  12427.                                         thechar:=chr(lo(ob_edchar));
  12428.                                         if thechar>=' ' then
  12429.                                             begin
  12430.                                                 vlen:=StrLen(pted^.te_pvalid);
  12431.                                                 if vlen=0 then vchar:='X'
  12432.                                                 else
  12433.                                                     if typ+1>vlen then vchar:=PChar(longint(pted^.te_pvalid)+vlen-1)^
  12434.                                                     else
  12435.                                                         vchar:=PChar(longint(pted^.te_pvalid)+typ)^;
  12436.                                                 if ValidChar(vchar) then
  12437.                                                     begin
  12438.                                                         if typ<=(pted^.te_txtlen-3) then
  12439.                                                             for q:=(pted^.te_txtlen-3) downto typ do
  12440.                                                                 PChar(longint(pted^.te_ptext)+q+1)^:=PChar(longint(pted^.te_ptext)+q)^;
  12441.                                                         PChar(longint(pted^.te_ptext)+typ)^:=thechar;
  12442.                                                         idx:=typ+1;
  12443.                                                         if pedt<>nil then pedt^.EdIdx:=idx;
  12444.                                                         eprint(true)
  12445.                                                     end
  12446.                                                 else
  12447.                                                     begin
  12448.                                                         q:=toffs;
  12449.                                                         typ:=0;
  12450.                                                         while typ<idx do
  12451.                                                             begin
  12452.                                                                 if PChar(longint(pted^.te_ptmplt)+q)^='_' then inc(typ);
  12453.                                                                 inc(q)
  12454.                                                             end;
  12455.                                                         while (PChar(longint(pted^.te_ptmplt)+q)^<>thechar) and (PChar(longint(pted^.te_ptmplt)+q)^<>#0) do
  12456.                                                             begin
  12457.                                                                 if PChar(longint(pted^.te_ptmplt)+q)^='_' then inc(typ);
  12458.                                                                 inc(q)
  12459.                                                             end;
  12460.                                                         if PChar(longint(pted^.te_ptmplt)+q)^=thechar then
  12461.                                                             begin
  12462.                                                                 if typ>idx then
  12463.                                                                     for q:=idx to typ-1 do
  12464.                                                                         PChar(longint(pted^.te_ptext)+q)^:=' ';
  12465.                                                                 PChar(longint(pted^.te_ptext)+typ)^:=#0;
  12466.                                                                 idx:=getmaxidx;
  12467.                                                                 if pedt<>nil then pedt^.EdIdx:=idx;
  12468.                                                                 eprint(true)
  12469.                                                             end
  12470.                                                     end
  12471.                                             end
  12472.                                     end;
  12473.                                     obedflag:=false;
  12474.                                     cursor
  12475.                                 end;
  12476.                 EDEND:  begin
  12477.                                     if pedt<>nil then pedt^.EdIdx:=idx;
  12478.                                     cursor
  12479.                                 end;
  12480.                 EDDRAW: cursor;
  12481.                 EDIDX:  begin
  12482.                                     typ:=(ob_edchar-ox) div chw;
  12483.                                     goto _edidx
  12484.                                 end;
  12485.                 EDIDXABS: begin
  12486.                                         typ:=ob_edchar;
  12487.                                         _edidx:
  12488.                                         if typ<0 then typ:=0;
  12489.                                         for q:=0 to typ do if PChar(longint(pted^.te_ptmplt)+toffs+q)^<>'_' then dec(typ);
  12490.                                         if typ>getmaxidx then typ:=getmaxidx;
  12491.                                         if typ<>idx then
  12492.                                             begin
  12493.                                                 cursor;
  12494.                                                 idx:=typ;
  12495.                                                 if pedt<>nil then pedt^.EdIdx:=idx;
  12496.                                                 cursor
  12497.                                             end
  12498.                                     end
  12499.                 else
  12500.                     objc_edit:=0
  12501.                 end;
  12502.                 RestoreVWrk
  12503.             end
  12504.         else
  12505.             objc_edit:=0
  12506.     end;
  12507.  
  12508. { *** TDIALOG *** }
  12509.  
  12510.  
  12511.  
  12512. { *** Objekt TTOOLBAR *** }
  12513.  
  12514. constructor TToolbar.Init(AParent: PWindow; ATree,AnIndx,Stat,Key: integer; Msg: pointer; GetHnd,Switch: boolean; Hlp: string);
  12515.     var tp: PTree;
  12516.  
  12517.     begin
  12518.         if not(inherited Init(AParent)) then fail;
  12519.         tp:=Application^.GetAddr(ATree);
  12520.         if (Parent=PEventObject(Application)) or (tp=nil) then
  12521.             begin
  12522.                 inherited Done;
  12523.                 fail
  12524.             end;
  12525.         Style:=Style or es_Toolbar;
  12526.         ADialog:=nil;
  12527.         IsSwitch:=Switch;
  12528.         ObjTree:=ATree;
  12529.         ObjIndx:=AnIndx;
  12530.         ObjAddr:=@tp^[ObjIndx];
  12531.         if ObjAddr=nil then
  12532.             begin
  12533.                 inherited Done;
  12534.                 fail
  12535.             end;
  12536.         with ObjAddr^ do
  12537.             begin
  12538.                 ob_flags:=ob_flags or SELECTABLE;
  12539.                 if (ob_type and $ff) in [G_BOX,G_BOXTEXT,G_BUTTON,G_BOXCHAR,G_FBOXTEXT] then
  12540.                     begin
  12541.                         if IsSwitch then ob_flags:=(ob_flags and not(FL3DMASK)) or FL3DIND
  12542.                         else
  12543.                             ob_flags:=(ob_flags and not(FL3DMASK)) or FL3DACT
  12544.                     end;
  12545.                 if (GEMVersion>=$0340) and (GEMVersion<>MAGIX) then
  12546.                     begin
  12547.                         if (ob_type and $ff) in [G_BOXTEXT,G_FBOXTEXT] then ob_state:=ob_state and not(SHADOWED or OUTLINED)
  12548.                     end
  12549.                 else
  12550.                     if Application^.Attr.Colors>=LWhite then
  12551.                         begin
  12552.                             if (ob_type and $ff) in [G_BOXTEXT,G_FBOXTEXT] then
  12553.                                 ob_spec.ted_info^.te_color:=(ob_spec.ted_info^.te_color and $ff00) or LWhite or $0070
  12554.                             else
  12555.                                 if (ob_type and $ff) in [G_BOX,G_BOXCHAR] then
  12556.                                     ob_spec.index:=(ob_spec.index and $ffffff00) or LWhite or $0070
  12557.                         end
  12558.             end;
  12559.         BHelp:=nil;
  12560.         SetHelp(Hlp);
  12561.         VKey:=Key;
  12562.         VStat:=Stat;
  12563.         VGHnd:=GetHnd;
  12564.         if Msg<>nil then
  12565.             begin
  12566.                 new(VPipe);
  12567.                 if VPipe<>nil then
  12568.                     begin
  12569.                         VPipe^:=PPipearray(Msg)^;
  12570.                         VPipe^[1]:=Application^.apID;
  12571.                         VPipe^[2]:=0
  12572.                     end
  12573.             end
  12574.         else
  12575.             VPipe:=nil
  12576.     end;
  12577.  
  12578.  
  12579. destructor TToolbar.Done;
  12580.  
  12581.     begin
  12582.         if VPipe<>nil then dispose(VPipe);
  12583.         DisposeStr(BHelp);
  12584.         inherited Done
  12585.     end;
  12586.  
  12587.  
  12588. function TToolbar.TestKey(Stat,Key: integer): boolean;
  12589.  
  12590.     begin
  12591.         if bTst(VStat,K_SHIFT) then
  12592.             if (Stat and K_SHIFT)>0 then Stat:=Stat or K_SHIFT;
  12593.         if (Stat=VStat) and (Key=VKey) and (GetState<>bf_Disabled) then
  12594.             begin
  12595.                 TestKey:=true;
  12596.                 if IsSwitch then Toggle
  12597.                 else
  12598.                     Check;
  12599.                 Work;
  12600.                 if VPipe<>nil then
  12601.                     begin
  12602.                         if VGHnd then VPipe^[3]:=PWindow(Parent)^.Attr.gemHandle;
  12603.                         appl_write(Application^.apID,16,VPipe)
  12604.                     end;
  12605.                 if hi(ObjAddr^.ob_type)>ROOT then
  12606.                     begin
  12607.                         if bTst(PWindow(Parent)^.Class.Style,cs_UserToolbar) then PWindow(Parent)^.MNSelected(hi(ObjAddr^.ob_type),0,nil,0)
  12608.                         else
  12609.                             Application^.MNSelected(hi(ObjAddr^.ob_type),0,nil,0)
  12610.                     end;
  12611.                 if not(IsSwitch) then Uncheck
  12612.             end
  12613.         else
  12614.             TestKey:=false
  12615.     end;
  12616.  
  12617.  
  12618. function TToolbar.TestMessage(Pipe: Pipearray): boolean;
  12619.  
  12620.     begin
  12621.         TestMessage:=false;
  12622.         if Pipe[0]=GO_PRIVATE then
  12623.             if Pipe[3]=GOP_TOOLBAR then
  12624.                 if Pipe[4]=ObjTree then
  12625.                     if Pipe[5]=ObjIndx then TestMessage:=true
  12626.     end;
  12627.  
  12628.  
  12629. function TToolbar.GetState: integer;
  12630.  
  12631.     begin
  12632.         if bTst(ObjAddr^.ob_state,DISABLED) then GetState:=bf_Disabled
  12633.         else
  12634.             GetState:=bf_Enabled
  12635.     end;
  12636.  
  12637.  
  12638. procedure TToolbar.SetState(StateFlag: integer);
  12639.  
  12640.     begin
  12641.         if GetState<>StateFlag then
  12642.             begin
  12643.                 with ObjAddr^ do
  12644.                     if StateFlag=bf_Disabled then
  12645.                         ob_state:=ob_state or DISABLED
  12646.                     else
  12647.                         ob_state:=ob_state and not(DISABLED);
  12648.                 Paint
  12649.             end
  12650.     end;
  12651.  
  12652.  
  12653. procedure TToolbar.Disable;
  12654.  
  12655.     begin
  12656.         SetState(bf_Disabled)
  12657.     end;
  12658.  
  12659.  
  12660. procedure TToolbar.Enable;
  12661.  
  12662.     begin
  12663.         SetState(bf_Enabled)
  12664.     end;
  12665.  
  12666.  
  12667. procedure TToolbar.SetCheck(CheckFlag: integer);
  12668.  
  12669.     begin
  12670.         if GetCheck<>CheckFlag then
  12671.             begin
  12672.                 with ObjAddr^ do
  12673.                     if CheckFlag=bf_Unchecked then ob_state:=ob_state and not(SELECTED)
  12674.                     else
  12675.                         ob_state:=ob_state or SELECTED;
  12676.                 Paint
  12677.             end
  12678.     end;
  12679.  
  12680.  
  12681. function TToolbar.GetCheck: integer;
  12682.  
  12683.     begin
  12684.         with ObjAddr^ do
  12685.             if bTst(ob_state,SELECTED) then GetCheck:=bf_Checked
  12686.             else
  12687.                 GetCheck:=bf_Unchecked
  12688.     end;
  12689.  
  12690.  
  12691. procedure TToolbar.Check;
  12692.  
  12693.     begin
  12694.         SetCheck(bf_Checked)
  12695.     end;
  12696.  
  12697.  
  12698. procedure TToolbar.Uncheck;
  12699.  
  12700.     begin
  12701.         SetCheck(bf_Unchecked)
  12702.     end;
  12703.  
  12704.  
  12705. procedure TToolbar.Toggle;
  12706.  
  12707.     begin
  12708.         if GetCheck=bf_Unchecked then SetCheck(bf_Checked)
  12709.         else
  12710.             SetCheck(bf_Unchecked)
  12711.     end;
  12712.  
  12713.  
  12714. procedure TToolbar.Paint;
  12715.     var box: GRECT;
  12716.  
  12717.     begin
  12718.         with PWindow(Parent)^ do
  12719.             begin
  12720.                 if Attr.Status<>ws_Open then exit;
  12721.                 if IsIconified then exit;
  12722.                 if (Class.ToolbarTree=nil) or (tbtree<>ObjTree) then exit;
  12723.                 wind_update(BEG_UPDATE);
  12724.                 HideMouse;
  12725.                 wind_get(Attr.gemHandle,WF_FIRSTXYWH,box.X,box.Y,box.W,box.H);
  12726.                 while (box.W>0) and (box.H>0) do
  12727.                     begin
  12728.                         if rc_intersect(DRect,box) then
  12729.                             with box do objc_draw(Class.ToolbarTree,ObjIndx,MAX_DEPTH,X,Y,W,H);
  12730.                         wind_get(Attr.gemHandle,WF_NEXTXYWH,box.X,box.Y,box.W,box.H)
  12731.                     end;
  12732.                 ShowMouse;
  12733.                 wind_update(END_UPDATE)
  12734.             end
  12735.     end;
  12736.  
  12737.  
  12738. function TToolbar.IsHelpAvailable: boolean;
  12739.  
  12740.     begin
  12741.         if BHelp=nil then IsHelpAvailable:=false
  12742.         else
  12743.             IsHelpAvailable:=(length(StrPTrimF(BHelp^))<>0)
  12744.     end;
  12745.  
  12746.  
  12747. function TToolbar.GetHelp: string;
  12748.  
  12749.     begin
  12750.         if BHelp<>nil then GetHelp:=BHelp^ else GetHelp:=''
  12751.     end;
  12752.  
  12753.  
  12754. procedure TToolbar.SetHelp(Hlp: string);
  12755.  
  12756.     begin
  12757.         DisposeStr(BHelp);
  12758.         BHelp:=NewStr(Hlp)
  12759.     end;
  12760.  
  12761.  
  12762. procedure TToolbar.SetMenuIndex(Indx: byte);
  12763.  
  12764.     begin
  12765.         with ObjAddr^ do ob_type:=(ob_type and $00ff) or (Indx shl 8)
  12766.     end;
  12767.  
  12768.  
  12769. function TToolbar.GetMenuIndex: byte;
  12770.  
  12771.     begin
  12772.         GetMenuIndex:=hi(ObjAddr^.ob_type)
  12773.     end;
  12774.  
  12775.  
  12776. procedure TToolbar.ClearMenuIndex;
  12777.  
  12778.     begin
  12779.         SetMenuIndex(0)
  12780.     end;
  12781.  
  12782. { *** Objekt TTOOLBAR *** }
  12783.  
  12784.  
  12785.  
  12786. { *** Objekt TKEYMENU *** }
  12787.  
  12788. constructor TKeyMenu.Init(AParent: PEventObject; Stat,Key,mNum,tNum: integer);
  12789.  
  12790.     begin
  12791.         if not(inherited Init(AParent)) then fail;
  12792.         Style:=Style or es_KeyMenu;
  12793.         ADialog:=nil;
  12794.         VStat:=Stat;
  12795.         VKey:=Key;
  12796.         VMNum:=mNum;
  12797.         VTNum:=tNum;
  12798.         VGHnd:=false;
  12799.         VPipe:=nil
  12800.     end;
  12801.  
  12802.  
  12803. destructor TKeyMenu.Done;
  12804.  
  12805.     begin
  12806.         if VPipe<>nil then dispose(VPipe);
  12807.         inherited Done
  12808.     end;
  12809.  
  12810.  
  12811. function TKeyMenu.TestKey(Stat,Key: integer): boolean;
  12812.  
  12813.     begin
  12814.         if bTst(VStat,K_SHIFT) then
  12815.             if (Stat and K_SHIFT)>0 then Stat:=Stat or K_SHIFT;
  12816.         if (Stat=VStat) and (Key=VKey) and (GetState<>bf_Disabled) then
  12817.             begin
  12818.                 TestKey:=true;
  12819.                 if (GetMenuTree<>nil) and (VTNum>=0) then
  12820.                     begin
  12821.                         if IsApp then menu_tnormal(GetMenuTree,VTNum,ME_INVERT)
  12822.                         else
  12823.                             Application^.TitleSelect(PWindow(Parent),VTNum,true)
  12824.                     end;
  12825.                 Work;
  12826.                 if VPipe<>nil then
  12827.                     begin
  12828.                         if not(VGHnd) then appl_write(Application^.apID,16,VPipe)
  12829.                         else
  12830.                             if IsApp then Application^.SendWndMessage(-1,VPipe,true,false)
  12831.                             else
  12832.                                 begin
  12833.                                     VPipe^[3]:=PWindow(Parent)^.Attr.gemHandle;
  12834.                                     appl_write(Application^.apID,16,VPipe)
  12835.                                 end
  12836.                     end;
  12837.                 if (GetMenuTree<>nil) and (VTNum>=0) then
  12838.                     begin
  12839.                         if IsApp then menu_tnormal(GetMenuTree,VTNum,ME_NORMAL)
  12840.                         else
  12841.                             Application^.TitleSelect(PWindow(Parent),VTNum,false)
  12842.                     end
  12843.             end
  12844.         else
  12845.             TestKey:=false
  12846.     end;
  12847.  
  12848.  
  12849. function TKeyMenu.TestMenu(mNum: integer): boolean;
  12850.  
  12851.     begin
  12852.         if mNum=VMNum then
  12853.             begin
  12854.                 TestMenu:=true;
  12855.                 Work;
  12856.                 if VPipe<>nil then
  12857.                     begin
  12858.                         if not(VGHnd) then appl_write(Application^.apID,16,VPipe)
  12859.                         else
  12860.                             if IsApp then Application^.SendWndMessage(-1,VPipe,true,false)
  12861.                             else
  12862.                                 begin
  12863.                                     VPipe^[3]:=PWindow(Parent)^.Attr.gemHandle;
  12864.                                     appl_write(Application^.apID,16,VPipe)
  12865.                                 end
  12866.                     end
  12867.             end
  12868.         else
  12869.          TestMenu:=false
  12870.     end;
  12871.  
  12872.  
  12873. function TKeyMenu.GetState: integer;
  12874.  
  12875.     begin
  12876.         if (GetMenuTree<>nil) and (VMNum>=0) then
  12877.             begin
  12878.                 if bTst(GetMenuTree^[VMNum].ob_state,DISABLED) then GetState:=bf_Disabled
  12879.                 else
  12880.                     GetState:=bf_Enabled
  12881.             end
  12882.         else
  12883.             GetState:=id_No
  12884.     end;
  12885.  
  12886.  
  12887. procedure TKeyMenu.SetState(StateFlag: integer);
  12888.  
  12889.     begin
  12890.         if InitMWrk then
  12891.             begin
  12892.                 if IsApp then
  12893.                     begin
  12894.                         if StateFlag=bf_Disabled then menu_ienable(GetMenuTree,VMNum,ME_DISABLE)
  12895.                         else
  12896.                             menu_ienable(GetMenuTree,VMNum,ME_ENABLE);
  12897.                     end
  12898.                 else
  12899.                     with GetMenuTree^[VMNum] do
  12900.                         begin
  12901.                             if StateFlag=bf_Disabled then ob_state:=ob_state or DISABLED
  12902.                             else
  12903.                                 ob_state:=ob_state and not(DISABLED)
  12904.                         end;
  12905.                 ExitMWrk
  12906.             end
  12907.     end;
  12908.  
  12909.  
  12910. procedure TKeyMenu.Disable;
  12911.  
  12912.     begin
  12913.         SetState(bf_Disabled)
  12914.     end;
  12915.  
  12916.  
  12917. procedure TKeyMenu.Enable;
  12918.  
  12919.     begin
  12920.         SetState(bf_Enabled)
  12921.     end;
  12922.  
  12923.  
  12924. function TKeyMenu.GetText: string;
  12925.  
  12926.     begin
  12927.         if (GetMenuTree<>nil) and (VMNum>=0) then
  12928.             GetText:=StrPas(GetMenuTree^[VMNum].ob_spec.free_string)
  12929.         else
  12930.             GetText:=''
  12931.     end;
  12932.  
  12933.  
  12934. procedure TKeyMenu.SetText(ATextString: string);
  12935.     var l: integer;
  12936.  
  12937.     begin
  12938.         if InitMWrk then
  12939.             begin
  12940.                 l:=length(GetText);
  12941.                 ATextString:=ATextString+StrPSpace(l-length(ATextString));
  12942.                 if IsApp then menu_text(GetMenuTree,VMNum,ATextString)
  12943.                 else
  12944.                     StrPCopy(PChar(GetMenuTree^[VMNum].ob_spec.free_string),ATextString);
  12945.                 ExitMWrk
  12946.             end
  12947.     end;
  12948.  
  12949.  
  12950. function TKeyMenu.GetCheck: integer;
  12951.  
  12952.     begin
  12953.         if (GetMenuTree<>nil) and (VMNum>=0) then
  12954.             begin
  12955.                 if bTst(GetMenuTree^[VMNum].ob_state,CHECKED) then GetCheck:=bf_Checked
  12956.                 else
  12957.                     GetCheck:=bf_Unchecked
  12958.             end
  12959.         else
  12960.             GetCheck:=id_No
  12961.     end;
  12962.  
  12963.  
  12964. procedure TKeyMenu.SetCheck(CheckFlag: integer);
  12965.  
  12966.     begin
  12967.         if InitMWrk then
  12968.             begin
  12969.                 if IsApp then
  12970.                     begin
  12971.                         if CheckFlag=bf_Checked then menu_icheck(GetMenuTree,VMNum,ME_CHECK)
  12972.                         else
  12973.                             menu_icheck(GetMenuTree,VMNum,ME_UNCHECK)
  12974.                     end
  12975.                 else
  12976.                     with GetMenuTree^[VMNum] do
  12977.                         begin
  12978.                             if CheckFlag=bf_Checked then ob_state:=ob_state or CHECKED
  12979.                             else
  12980.                                 ob_state:=ob_state and not(CHECKED)
  12981.                         end;
  12982.                 ExitMWrk
  12983.             end
  12984.     end;
  12985.  
  12986.  
  12987. procedure TKeyMenu.Check;
  12988.  
  12989.     begin
  12990.         SetCheck(bf_Checked)
  12991.     end;
  12992.  
  12993.  
  12994. procedure TKeyMenu.Uncheck;
  12995.  
  12996.     begin
  12997.         SetCheck(bf_Unchecked)
  12998.     end;
  12999.  
  13000.  
  13001. procedure TKeyMenu.Toggle;
  13002.  
  13003.     begin
  13004.         if GetCheck=bf_Unchecked then SetCheck(bf_Checked)
  13005.         else
  13006.             SetCheck(bf_Unchecked)
  13007.     end;
  13008.  
  13009.  
  13010.     { private }
  13011.  
  13012.  
  13013. function TKeyMenu.InitMWrk: boolean;
  13014.     var valid: boolean;
  13015.  
  13016.     begin
  13017.         valid:=(GetMenuTree<>nil) and (VMNum>=0);
  13018.         if valid then wind_update(BEG_UPDATE);
  13019.         InitMWrk:=valid
  13020.     end;
  13021.  
  13022.  
  13023. procedure TKeyMenu.ExitMWrk;
  13024.  
  13025.     begin
  13026.         wind_update(END_UPDATE)
  13027.     end;
  13028.  
  13029.  
  13030. function TKeyMenu.IsApp: boolean;
  13031.  
  13032.     begin
  13033.         IsApp:=(Parent=PEventObject(Application))
  13034.     end;
  13035.  
  13036.  
  13037. function TKeyMenu.GetMenuTree: PTree;
  13038.  
  13039.     begin
  13040.         if IsApp then GetMenuTree:=Application^.MenuTree
  13041.         else
  13042.             GetMenuTree:=PWindow(Parent)^.Class.MenuTree
  13043.     end;
  13044.  
  13045. { *** TKEYMENU *** }
  13046.  
  13047.  
  13048.  
  13049. { *** Objekt TKEY *** }
  13050.  
  13051. constructor TKey.Init(AParent: PEventObject; Stat,Key: integer; Msg: pointer; GetHnd: boolean);
  13052.  
  13053.     begin
  13054.         if not(inherited Init(AParent,Stat,Key,-1,-1)) then fail;
  13055.         VGHnd:=GetHnd;
  13056.         if Msg<>nil then
  13057.             begin
  13058.                 new(VPipe);
  13059.                 if VPipe<>nil then
  13060.                     begin
  13061.                         VPipe^:=PPipearray(Msg)^;
  13062.                         VPipe^[1]:=Application^.apID;
  13063.                         VPipe^[2]:=0
  13064.                     end
  13065.             end
  13066.     end;
  13067.  
  13068.  
  13069. function TKey.TestMenu(mNum: integer): boolean;
  13070.  
  13071.     begin
  13072.         TestMenu:=false
  13073.     end;
  13074.  
  13075. { *** TKEY *** }
  13076.  
  13077.  
  13078.  
  13079. { *** Objekt TMENU *** }
  13080.  
  13081. constructor TMenu.Init(AParent: PEventObject; mNum: integer; Msg: pointer; GetHnd: boolean);
  13082.  
  13083.     begin
  13084.         if not(inherited Init(AParent,K_NORMAL,id_No,mNum,-1)) then fail;
  13085.         VGHnd:=GetHnd;
  13086.         if Msg<>nil then
  13087.             begin
  13088.                 new(VPipe);
  13089.                 if VPipe<>nil then
  13090.                     begin
  13091.                         VPipe^:=PPipearray(Msg)^;
  13092.                         VPipe^[1]:=Application^.apID;
  13093.                         VPipe^[2]:=0
  13094.                     end
  13095.             end
  13096.     end;
  13097.  
  13098.  
  13099. function TMenu.TestKey(Stat,Key: integer): boolean;
  13100.  
  13101.     begin
  13102.         TestKey:=false
  13103.     end;
  13104.  
  13105. { *** TMENU *** }
  13106.  
  13107.  
  13108.  
  13109. function TDKey.TestKey(Stat,Key: integer): boolean;
  13110.     var nx,dummy,tx,robj,mx,my: integer;
  13111.         valid,found           : boolean;
  13112.         kpc,pcte              : PControl;
  13113.  
  13114.     procedure invrt(tid: integer);
  13115.         var p: PControl;
  13116.  
  13117.         begin
  13118.             with PDialog(Parent)^ do
  13119.                 begin
  13120.                     kpc:=nil;
  13121.                     p:=CtrlList;
  13122.                     while (p<>nil) do
  13123.                         with p^ do
  13124.                             begin
  13125.                                 if TestID(tid) then kpc:=p;
  13126.                                 p:=Nxt
  13127.                             end;
  13128.                     if kpc<>nil then
  13129.                         begin
  13130.                             if bTst(DlgTree^[kpc^.ObjIndx].ob_flags,SELECTABLE) then
  13131.                                 begin
  13132.                                     DlgTree^[kpc^.ObjIndx].ob_state:=DlgTree^[kpc^.ObjIndx].ob_state or SELECTED;
  13133.                                     ObjcPaint(kpc^.ObjIndx,false)
  13134.                                 end
  13135.                             else
  13136.                                 kpc:=nil
  13137.                         end
  13138.                 end
  13139.         end;
  13140.  
  13141.     begin
  13142.         TestKey:=false;
  13143.         with PDialog(Parent)^ do
  13144.             if Cont then
  13145.                 begin
  13146.                     dummy:=integer(MapKey(Key));
  13147.                     if bTst(hi(dummy),KsALT) then
  13148.                         begin
  13149.                             Cont:=true;
  13150.                             Key:=0;
  13151.                             next_obj:=0;
  13152.                             nx:=0;
  13153.                             dummy:=ord(upcase(chr(lo(dummy))));
  13154.                             kpc:=CtrlList;
  13155.                             while (kpc<>nil) and Cont do
  13156.                                 begin
  13157.                                     if kpc^.TestShortCut(dummy) then
  13158.                                         begin
  13159.                                             TestKey:=true;
  13160.                                             if kpc^.GetState<>bf_Disabled then
  13161.                                                 begin
  13162.                                                     Cont:=false;
  13163.                                                     nx:=kpc^.ObjIndx
  13164.                                                 end
  13165.                                         end;
  13166.                                     kpc:=kpc^.Nxt
  13167.                                 end;
  13168.                             if not(Cont) then
  13169.                                 begin
  13170.                                     dummy:=DlgTree^[nx].ob_state;
  13171.                                     if bTst(DlgTree^[nx].ob_flags,SELECTABLE) then
  13172.                                         begin
  13173.                                             if bTst(DlgTree^[nx].ob_flags,RBUTTON) then
  13174.                                                 begin
  13175.                                                     if not(bTst(dummy,SELECTED)) then
  13176.                                                         begin
  13177.                                                             robj:=nx;
  13178.                                                             repeat
  13179.                                                                 tx:=DlgTree^[robj].ob_next;
  13180.                                                                 if DlgTree^[tx].ob_tail=robj then
  13181.                                                                     robj:=DlgTree^[tx].ob_head
  13182.                                                                 else
  13183.                                                                     robj:=tx;
  13184.                                                                 if bTst(DlgTree^[robj].ob_state,SELECTED) then
  13185.                                                                     begin
  13186.                                                                         objc_change(DlgTree,robj,0,0,0,1,1,DlgTree^[robj].ob_state and not(SELECTED),1);
  13187.                                                                         ObjcPaint(robj,false)
  13188.                                                                     end;
  13189.                                                             until robj=nx;
  13190.                                                             objc_change(DlgTree,nx,0,0,0,1,1,dummy or SELECTED,1);
  13191.                                                             ObjcPaint(nx,false);
  13192.                                                             CallChanged(nx,false,false,false)
  13193.                                                         end
  13194.                                                 end
  13195.                                             else
  13196.                                                 begin
  13197.                                                     if bTst(DlgTree^[nx].ob_flags,F_EXIT) then dummy:=dummy or SELECTED
  13198.                                                         else dummy:=dummy xor SELECTED;
  13199.                                                     objc_change(DlgTree,nx,0,0,0,1,1,dummy,1);
  13200.                                                     ObjcPaint(nx,false);
  13201.                                                     CallChanged(nx,false,false,false)
  13202.                                                 end
  13203.                                         end
  13204.                                     else
  13205.                                         CallChanged(nx,false,false,false);
  13206.                                     if (DlgTree^[nx].ob_flags and (F_EXIT or TOUCHEXIT))=0 then Cont:=true
  13207.                                     else
  13208.                                         EndDlg(nx,false);
  13209.                                     exit
  13210.                                 end
  13211.                         end
  13212.                     else
  13213.                         Cont:=(Application^.form_keybd(DlgTree,edit_obj,0,Key,next_obj,Key)<>0);
  13214.                     if not(Cont) then
  13215.                         begin
  13216.                             TestKey:=true;
  13217.                             nx:=next_obj;
  13218.                             next_obj:=0;
  13219.                             if bTst(DlgTree^[nx].ob_flags,SELECTABLE) then
  13220.                                 begin
  13221.                                     DlgTree^[nx].ob_state:=DlgTree^[nx].ob_state or SELECTED;
  13222.                                     ObjcPaint(nx,false)
  13223.                                 end;
  13224.                             CallChanged(nx,false,false,false);
  13225.                             EndDlg(nx,false);
  13226.                             exit
  13227.                         end;
  13228.                     if Key<>0 then
  13229.                         begin
  13230.                             found:=false;
  13231.                             valid:=false;
  13232.                             case Key of
  13233.                             S_Help: begin
  13234.                                                 TestKey:=true;
  13235.                                                 graf_mkstate(mx,my,dummy,dummy);
  13236.                                                 tx:=objc_find(DlgTree,ROOT,MAX_DEPTH,mx,my);
  13237.                                                 if tx>-1 then
  13238.                                                     begin
  13239.                                                         pcte:=CtrlList;
  13240.                                                         while (pcte<>nil) do
  13241.                                                             with pcte^ do
  13242.                                                                 begin
  13243.                                                                     if TestIndex(tx) then
  13244.                                                                         if IsHelpAvailable then
  13245.                                                                             begin
  13246.                                                                                 Application^.BubbleHelp(mx,my,bbldelay,GetHelp);
  13247.                                                                                 valid:=true
  13248.                                                                             end;
  13249.                                                                     pcte:=Nxt
  13250.                                                                 end
  13251.                                                     end;
  13252.                                                 if not(valid) then
  13253.                                                     begin
  13254.                                                       invrt(id_Help);
  13255.                                                         valid:=Help;
  13256.                                                         found:=true
  13257.                                                     end
  13258.                                             end
  13259.                             else
  13260.                                 if edit_obj>0 then
  13261.                                     begin
  13262.                                         objc_edit(Key,EDCHAR,Work.A2,true);
  13263.                                         TestKey:=(Key=0)
  13264.                                     end
  13265.                                 else
  13266.                                     case Key of
  13267.                                     S_Esc: begin
  13268.                                                      TestKey:=true;
  13269.                                                      invrt(id_Esc);
  13270.                                                      valid:=Esc;
  13271.                                                      found:=true
  13272.                                                  end;
  13273.                                     S_Undo: begin
  13274.                                                         TestKey:=true;
  13275.                                                         invrt(id_Undo);
  13276.                                                          valid:=Undo;
  13277.                                                          found:=true
  13278.                                                     end
  13279.                                     end
  13280.                             end;
  13281.                             if found then
  13282.                                 begin
  13283.                                     if valid then
  13284.                                         begin
  13285.                                             Result:=id_No;
  13286.                                             if CanClose then
  13287.                                                 begin
  13288.                                                     if kpc<>nil then
  13289.                                                         DlgTree^[kpc^.ObjIndx].ob_state:=DlgTree^[kpc^.ObjIndx].ob_state and not(SELECTED);
  13290.                                                     Cont:=false;
  13291.                                                     Destroy;
  13292.                                                     exit
  13293.                                                 end
  13294.                                             else
  13295.                                                 if kpc<>nil then
  13296.                                                     begin
  13297.                                                         DlgTree^[kpc^.ObjIndx].ob_state:=DlgTree^[kpc^.ObjIndx].ob_state and not(SELECTED);
  13298.                                                         ObjcPaint(kpc^.ObjIndx,false)
  13299.                                                     end
  13300.                                         end
  13301.                                     else
  13302.                                         if kpc<>nil then
  13303.                                             begin
  13304.                                                 DlgTree^[kpc^.ObjIndx].ob_state:=DlgTree^[kpc^.ObjIndx].ob_state and not(SELECTED);
  13305.                                                 ObjcPaint(kpc^.ObjIndx,false)
  13306.                                             end
  13307.                                 end
  13308.                         end;
  13309.                     if (next_obj>0) and (edit_obj<>next_obj) then
  13310.                         begin
  13311.                             objc_edit(dummy,EDEND,Work.A2,true);
  13312.                             edit_obj:=next_obj;
  13313.                             next_obj:=0;
  13314.                             CallChanged(edit_obj,false,true,false);
  13315.                             objc_edit(dummy,EDINIT,Work.A2,true)
  13316.                         end
  13317.                 end
  13318.     end;
  13319.  
  13320.  
  13321. procedure TQKey.Work;
  13322.  
  13323.     begin
  13324.         Application^.Quit
  13325.     end;
  13326.  
  13327.  
  13328. function TMenuPopup.ExitPop(mX,mY: integer): integer;
  13329.     label _weiter;
  13330.  
  13331.     var objc,pdx,rh,rx,ry: integer;
  13332.         box,maus         : GRECT;
  13333.  
  13334.     begin
  13335.         wind_get(PWindow(Parent)^.Attr.gemHandle,WF_WORKXYWH,rx,ry,rh,rh);
  13336.         if (mY<ry) or (mX<rx) then
  13337.             begin
  13338.                 ExitPop:=-2;
  13339.                 exit
  13340.             end
  13341.         else
  13342.             ExitPop:=id_No;
  13343.         maus.X:=mX;
  13344.         maus.Y:=mY;
  13345.         maus.W:=1;
  13346.         maus.H:=1;
  13347.         wind_get(PWindow(Parent)^.Attr.gemHandle,WF_FIRSTXYWH,box.X,box.Y,box.W,box.H);
  13348.         while (box.W>0) and (box.H>0) do
  13349.             begin
  13350.                 if rc_intersect(DRect,box) then
  13351.                     if rc_intersect(maus,box) then goto _weiter;
  13352.                 wind_get(PWindow(Parent)^.Attr.gemHandle,WF_NEXTXYWH,box.X,box.Y,box.W,box.H)
  13353.             end;
  13354.         exit;
  13355.         _weiter:
  13356.         objc:=objc_find(PopTree,PopTree^[ROOT].ob_head,MAX_DEPTH,mX,mY);
  13357.         pdx:=objc-PopTree^[PopTree^[PopTree^[ROOT].ob_head].ob_head].ob_head;
  13358.         if pdx>=0 then
  13359.             begin
  13360.                 ExitPop:=pdx+10000;
  13361.                 rh:=PopTree^[PopTree^[ROOT].ob_tail].ob_head;
  13362.                 while pdx>0 do
  13363.                     begin
  13364.                         rh:=PopTree^[rh].ob_next;
  13365.                         dec(pdx)
  13366.                     end;
  13367.                 if rh=pIndex then ExitPop:=id_No
  13368.             end
  13369.     end;
  13370.  
  13371.  
  13372. function TMenuPopup.KeyExit(Stat,Key: integer): integer;
  13373.     var inx,anz,nnum,num,dif,objc: integer;
  13374.  
  13375.     function objvisible: boolean;
  13376.         label _weiter;
  13377.  
  13378.         var q      : integer;
  13379.             mnu,box: GRECT;
  13380.  
  13381.         begin
  13382.             objvisible:=false;
  13383.             q:=nnum;
  13384.             objc:=PopTree^[PopTree^[PopTree^[ROOT].ob_head].ob_head].ob_head;
  13385.             while q>0 do
  13386.                 begin
  13387.                     objc:=PopTree^[objc].ob_next;
  13388.                     dec(q)
  13389.                 end;
  13390.             objc_offset(PopTree,objc,mnu.X,mnu.Y);
  13391.             with PopTree^[objc] do
  13392.                 begin
  13393.                     mnu.W:=ob_width;
  13394.                     mnu.H:=ob_height
  13395.                 end;
  13396.             wind_get(PWindow(Parent)^.Attr.gemHandle,WF_FIRSTXYWH,box.X,box.Y,box.W,box.H);
  13397.             while (box.W>0) and (box.H>0) do
  13398.                 begin
  13399.                     if rc_intersect(DRect,box) then
  13400.                         if rc_intersect(mnu,box) then goto _weiter;
  13401.                     wind_get(PWindow(Parent)^.Attr.gemHandle,WF_NEXTXYWH,box.X,box.Y,box.W,box.H)
  13402.                 end;
  13403.             exit;
  13404.             _weiter:
  13405.             objvisible:=true;
  13406.             if nnum<>num then SetMouse(box.X+(box.W shr 1),box.Y+(box.H shr 1))
  13407.         end;
  13408.  
  13409.     begin
  13410.         KeyExit:=id_No;
  13411.         dif:=0;
  13412.         if Stat=K_NORMAL then
  13413.             case Key of
  13414.             Cur_Left:
  13415.                 dif:=-1;
  13416.             Cur_Right:
  13417.                 dif:=1
  13418.             end;
  13419.         if dif=0 then exit;
  13420.         anz:=0;
  13421.         num:=0;
  13422.         inx:=PopTree^[PopTree^[ROOT].ob_tail].ob_head;
  13423.         while PopTree^[inx].ob_next<>PopTree^[ROOT].ob_tail do
  13424.             begin
  13425.                 inc(anz);
  13426.                 inx:=PopTree^[inx].ob_next;
  13427.                 if inx=pIndex then num:=anz
  13428.             end;
  13429.         nnum:=num;
  13430.         repeat
  13431.             inc(nnum,dif);
  13432.             if nnum<0 then nnum:=anz;
  13433.             if nnum>anz then nnum:=0
  13434.         until objvisible
  13435.     end;
  13436.  
  13437.  
  13438. constructor TIcnWnd.Init(AParent: PWindow; ATitle: string; x,y,w,h: integer);
  13439.  
  13440.     begin
  13441.         if not(inherited Init(AParent,ATitle)) then fail;
  13442.         icx:=x;
  13443.         icy:=y;
  13444.         icw:=w;
  13445.         ich:=h;
  13446.         Create;
  13447.         if Attr.Status in [ws_Created,ws_Open] then wind_set(Attr.gemHandle,WF_ICONIFY,icx,icy,icw,ich);
  13448.         GetCurr;
  13449.         GetWork;
  13450.         OpenWindow
  13451.     end;
  13452.  
  13453.  
  13454. procedure TIcnWnd.SetupWindow;
  13455.  
  13456.     begin
  13457.         LoadIcon(new(PIcon,Init(@self,Application^.ticn,Application^.iicn,0,0,false,false,'','')));
  13458.         Application^.Icon:=Icon;
  13459.         inherited SetupWindow
  13460.     end;
  13461.  
  13462.  
  13463. procedure TIcnWnd.MakeWindow;
  13464.     var valid: boolean;
  13465.  
  13466.     begin
  13467.         valid:=(Attr.Status=ws_NoWindow);
  13468.         Create;
  13469.         if valid and (Attr.Status=ws_Created) then wind_set(Attr.gemHandle,WF_ICONIFY,icx,icy,icw,ich);
  13470.         GetCurr;
  13471.         GetWork;
  13472.         OpenWindow
  13473.     end;
  13474.  
  13475.  
  13476. procedure TIcnWnd.IconPaint(var PaintInfo: TPaintStruct);
  13477.  
  13478.     begin
  13479.         Application^.IconPaint(Work,PaintInfo)
  13480.     end;
  13481.  
  13482.  
  13483. procedure TXAccCollection.FreeItem(Item: pointer);
  13484.  
  13485.     begin
  13486.         if Item<>nil then
  13487.             begin
  13488.                 with PXAccAttr(Item)^ do
  13489.                     begin
  13490.                         DisposeStr(AppTypeHR);
  13491.                         DisposeStr(ExtFeatures);
  13492.                         DisposeStr(GenericName);
  13493.                         DisposeStr(Name)
  13494.                     end;
  13495.                 dispose(PXAccAttr(Item));
  13496.             end
  13497.     end;
  13498.  
  13499.  
  13500. procedure TProfileCollection.FreeItem(Item: pointer);
  13501.  
  13502.     begin
  13503.         ChrDispose(PChar(Item))
  13504.     end;
  13505.  
  13506.  
  13507. procedure IconifyFadeout(p: PWindow);
  13508.  
  13509.     begin
  13510.         if p<>Application^.icnwnd then p^.Iconify(true)
  13511.     end;
  13512.  
  13513.  
  13514. procedure IconifyFadein(p: PWindow);
  13515.  
  13516.     begin
  13517.         if p<>Application^.icnwnd then p^.Iconify(false)
  13518.     end;
  13519.  
  13520.  
  13521. procedure SendXaccExit(p: PXAccAttr);
  13522.     var pipe: Pipearray;
  13523.  
  13524.     begin
  13525.         pipe[1]:=Application^.apID;
  13526.         pipe[2]:=0;
  13527.         if bTst(p^.Protocol,PROTO_XACC) then
  13528.             begin
  13529.                 pipe[0]:=ACC_EXIT;
  13530.                 appl_write(p^.apID,16,@pipe)
  13531.             end;
  13532.         if bTst(p^.Protocol,PROTO_AV) then
  13533.             begin
  13534.                 pipe[0]:=AV_EXIT;
  13535.                 pipe[3]:=pipe[1];
  13536.                 appl_write(p^.apID,16,@pipe)
  13537.             end
  13538.     end;
  13539.  
  13540.  
  13541. procedure InitVWrk;
  13542.     var dummy: integer;
  13543.         dstr : string[32];
  13544.  
  13545.     begin
  13546.         with Application^ do
  13547.             begin
  13548.                 gem.vswr_mode(vdiHandle,MD_REPLACE);
  13549.                 gem.vst_font(vdiHandle,vqt_name(vdiHandle,1,dstr));
  13550.                 gem.vst_height(vdiHandle,SysInfo.SFHeight,dummy,dummy,dummy,dummy);
  13551.                 gem.vst_rotation(vdiHandle,0);
  13552.                 gem.vst_color(vdiHandle,Black);
  13553.                 gem.vst_alignment(vdiHandle,TA_LEFT,TA_BASELINE,dummy,dummy);
  13554.                 gem.vst_effects(vdiHandle,TF_NORMAL);
  13555.                 gem.vsf_interior(vdiHandle,FIS_HOLLOW);
  13556.                 gem.vsf_style(vdiHandle,4);
  13557.                 gem.vsf_color(vdiHandle,Black);
  13558.                 gem.vsf_perimeter(vdiHandle,PER_ON);
  13559.                 gem.vsl_color(vdiHandle,Black);
  13560.                 gem.vsl_type(vdiHandle,LT_SOLID);
  13561.                 gem.vsl_ends(vdiHandle,LE_SQUARED,LE_SQUARED);
  13562.                 gem.vsl_width(vdiHandle,1)
  13563.             end
  13564.     end;
  13565.  
  13566.  
  13567. procedure RestoreVWrk;
  13568.     var dummy: integer;
  13569.  
  13570.     begin
  13571.         with Application^ do
  13572.             begin
  13573.                 gem.vst_font(vdiHandle,GP.font);
  13574.                 if GP.tpoint>=0 then gem.vst_point(vdiHandle,GP.tpoint,dummy,dummy,dummy,dummy)
  13575.                     else gem.vst_height(vdiHandle,GP.theight,dummy,dummy,dummy,dummy);
  13576.                 gem.vst_rotation(vdiHandle,GP.trotation);
  13577.                 gem.vst_color(vdiHandle,GP.tcolor);
  13578.                 gem.vst_alignment(vdiHandle,GP.horalign,GP.veralign,dummy,dummy);
  13579.                 gem.vst_effects(vdiHandle,GP.teffects);
  13580.                 gem.vsf_perimeter(vdiHandle,GP.fperimeter);
  13581.                 gem.vsf_interior(vdiHandle,GP.finterior);
  13582.                 gem.vsf_style(vdiHandle,GP.fstyle);
  13583.                 gem.vsf_color(vdiHandle,GP.fcolor);
  13584.                 gem.vsl_type(vdiHandle,GP.ltype);
  13585.                 gem.vsl_ends(vdiHandle,GP.lendsb,GP.lendse);
  13586.                 gem.vsl_width(vdiHandle,GP.lwidth);
  13587.                 gem.vsl_color(vdiHandle,GP.lcolor);
  13588.                 gem.vswr_mode(vdiHandle,GP.wrmode);
  13589.                 vs_clip(vdiHandle,CLIP_ON,DRect.A2)
  13590.             end
  13591.     end;
  13592.  
  13593.  
  13594. function DrawMenuRect(dummy1,dummy2: pointer; parm: PARMBLKPtr): word;
  13595.     var pxy: ARRAY_4;
  13596.  
  13597.     begin
  13598.         with parm^ do
  13599.             begin
  13600.                 pxy[0]:=pb_x;
  13601.                 pxy[1]:=pb_y+(pb_h shr 1)-1;
  13602.                 pxy[2]:=pb_x+pb_w-1;
  13603.                 pxy[3]:=pb_y+(pb_h shr 1)
  13604.             end;
  13605.         InitVWrk;
  13606.         with Application^ do
  13607.             begin
  13608.                 if Attr.Colors>=LWhite then
  13609.                     begin
  13610.                         gem.vsf_interior(vdiHandle,FIS_SOLID);
  13611.                         gem.vsf_color(vdiHandle,LWhite)
  13612.                     end
  13613.                 else
  13614.                     gem.vsf_interior(vdiHandle,FIS_PATTERN);
  13615.                 vr_recfl(vdiHandle,pxy)
  13616.             end;
  13617.         RestoreVWrk;
  13618.         DrawMenuRect:=NORMAL
  13619.     end;
  13620.  
  13621.  
  13622. function DrawTitle(dummy1,dummy2: pointer; parm: PARMBLKPtr): word;
  13623.     var clip: ARRAY_4;
  13624.  
  13625.     begin
  13626.         InitVWrk;
  13627.         with parm^ do
  13628.             begin
  13629.                 clip[0]:=pb_xc;
  13630.                 clip[1]:=pb_yc;
  13631.                 clip[2]:=pb_xc+pb_wc-1;
  13632.                 clip[3]:=pb_yc+pb_hc-1
  13633.             end;
  13634.         with Application^ do
  13635.             begin
  13636.                 vs_clip(vdiHandle,CLIP_ON,clip);
  13637.                 gem.vst_effects(vdiHandle,TF_UNDERLINED);
  13638.                 gem.vswr_mode(vdiHandle,MD_ERASE);
  13639.                 gem.vst_color(vdiHandle,SysInfo.BGDefCol);
  13640.                 v_gtext(vdiHandle,parm^.pb_x,parm^.pb_y+SysInfo.SFHeight,StrPas(PChar(parm^.pb_parm)));
  13641.                 gem.vswr_mode(vdiHandle,MD_TRANS);
  13642.                 gem.vst_color(vdiHandle,Black);
  13643.                 v_gtext(vdiHandle,parm^.pb_x,parm^.pb_y+SysInfo.SFHeight,StrPas(PChar(parm^.pb_parm)))
  13644.             end;
  13645.         RestoreVWrk;
  13646.         DrawTitle:=NORMAL
  13647.     end;
  13648.  
  13649.  
  13650. function DrawStatic(dummy1,dummy2: pointer; parm: PARMBLKPtr): word;
  13651.     var clip: ARRAY_4;
  13652.  
  13653.     begin
  13654.         InitVWrk;
  13655.         with parm^ do
  13656.             begin
  13657.                 clip[0]:=pb_xc;
  13658.                 clip[1]:=pb_yc;
  13659.                 clip[2]:=pb_xc+pb_wc-1;
  13660.                 clip[3]:=pb_yc+pb_hc-1
  13661.             end;
  13662.         with Application^ do
  13663.             begin
  13664.                 vs_clip(vdiHandle,CLIP_ON,clip);
  13665.                 if bTst(parm^.pr_currstate,DISABLED) then gem.vst_effects(vdiHandle,TF_LIGHTENED);
  13666.                 gem.vswr_mode(vdiHandle,MD_ERASE);
  13667.                 gem.vst_color(vdiHandle,SysInfo.BGDefCol);
  13668.                 v_gtext(vdiHandle,parm^.pb_x,parm^.pb_y+SysInfo.SFHeight,StrPas(PChar(parm^.pb_parm)));
  13669.                 gem.vswr_mode(vdiHandle,MD_TRANS);
  13670.                 gem.vst_color(vdiHandle,Black);
  13671.                 v_gtext(vdiHandle,parm^.pb_x,parm^.pb_y+SysInfo.SFHeight,StrPas(PChar(parm^.pb_parm)))
  13672.             end;
  13673.         RestoreVWrk;
  13674.         DrawStatic:=parm^.pr_currstate and not(DISABLED)
  13675.     end;
  13676.  
  13677.  
  13678. function DrawPushButton(dummy1,dummy2: pointer; parm: PARMBLKPtr): word;
  13679.     var clip         : ARRAY_4;
  13680.         q,ty,tx,scpos: integer;
  13681.         btn          : string[30];
  13682.  
  13683.     begin
  13684.         InitVWrk;
  13685.         with parm^ do
  13686.             begin
  13687.                 clip[0]:=pb_xc;
  13688.                 clip[1]:=pb_yc;
  13689.                 clip[2]:=pb_xc+pb_wc-1;
  13690.                 clip[3]:=pb_yc+pb_hc-1;
  13691.                 vs_clip(Application^.vdiHandle,CLIP_ON,clip);
  13692.                 inc(pb_x,5);
  13693.                 inc(pb_y,5);
  13694.                 dec(pb_w,10);
  13695.                 dec(pb_h,10);
  13696.                 clip[0]:=pb_x-1;
  13697.                 clip[1]:=pb_y-1;
  13698.                 clip[2]:=pb_x+pb_w;
  13699.                 clip[3]:=pb_y+pb_h-1
  13700.             end;
  13701.         with Application^ do
  13702.             begin
  13703.                 gem.vsf_interior(vdiHandle,FIS_SOLID);
  13704.                 gem.vsf_color(vdiHandle,bfalcol);
  13705.                 v_bar(vdiHandle,clip);
  13706.                 btn:=StrLPas(PChar(parm^.pb_parm),30);
  13707.                 scpos:=pos('&',btn);
  13708.                 if scpos>0 then
  13709.                     begin
  13710.                         for q:=scpos to length(btn)-1 do btn[q]:=btn[q+1];
  13711.                         btn[0]:=chr(ord(btn[0])-1)
  13712.                     end;
  13713.                 tx:=parm^.pb_x+((parm^.pb_w-length(btn)*Attr.charSWidth) shr 1);
  13714.                 ty:=parm^.pb_y+SysInfo.SFHeight-1;
  13715.                 if bTst(parm^.pr_currstate,SELECTED) then
  13716.                     begin
  13717.                         pxya[0]:=clip[0]-1;
  13718.                         pxya[1]:=clip[3];
  13719.                         pxya[2]:=pxya[0];
  13720.                         pxya[3]:=clip[1]-1;
  13721.                         pxya[4]:=clip[2];
  13722.                         pxya[5]:=pxya[3];
  13723.                         gem.vsl_color(vdiHandle,LBlack);
  13724.                         v_pline(vdiHandle,3,pxya);
  13725.                         pxya[0]:=clip[0];
  13726.                         pxya[1]:=clip[3]+1;
  13727.                         pxya[2]:=clip[2]+1;
  13728.                         pxya[3]:=pxya[1];
  13729.                         pxya[4]:=pxya[2];
  13730.                         pxya[5]:=clip[1];
  13731.                         gem.vsl_color(vdiHandle,White);
  13732.                         v_pline(vdiHandle,3,pxya);
  13733.                         inc(tx);
  13734.                         inc(ty)
  13735.                     end
  13736.                 else
  13737.                     begin
  13738.                         pxya[0]:=clip[0]-1;
  13739.                         pxya[1]:=clip[3];
  13740.                         pxya[2]:=pxya[0];
  13741.                         pxya[3]:=clip[1]-1;
  13742.                         pxya[4]:=clip[2];
  13743.                         pxya[5]:=pxya[3];
  13744.                         gem.vsl_color(vdiHandle,White);
  13745.                         v_pline(vdiHandle,3,pxya);
  13746.                         pxya[0]:=clip[0];
  13747.                         pxya[1]:=clip[3]+1;
  13748.                         pxya[2]:=clip[2]+1;
  13749.                         pxya[3]:=pxya[1];
  13750.                         pxya[4]:=pxya[2];
  13751.                         pxya[5]:=clip[1];
  13752.                         gem.vsl_color(vdiHandle,LBlack);
  13753.                         v_pline(vdiHandle,3,pxya)
  13754.                     end;
  13755.                 if Attr.Colors>=LWhite then gem.vsl_color(vdiHandle,LWhite)
  13756.                 else
  13757.                     gem.vsl_color(vdiHandle,White);
  13758.                 pxya[0]:=clip[0]-1;
  13759.                 pxya[1]:=clip[3]+1;
  13760.                 pxya[2]:=pxya[0];
  13761.                 pxya[3]:=pxya[1];
  13762.                 v_pline(vdiHandle,2,pxya);
  13763.                 pxya[0]:=clip[2]+1;
  13764.                 pxya[1]:=clip[1]-1;
  13765.                 pxya[2]:=pxya[0];
  13766.                 pxya[3]:=pxya[1];
  13767.                 v_pline(vdiHandle,2,pxya);
  13768.                 gem.vsl_color(vdiHandle,Black);
  13769.                 dec(clip[0],2);
  13770.                 dec(clip[1],2);
  13771.                 inc(clip[2],2);
  13772.                 inc(clip[3],2);
  13773.                 pxya[0]:=clip[0];
  13774.                 pxya[1]:=clip[1];
  13775.                 pxya[2]:=clip[2];
  13776.                 pxya[3]:=clip[1];
  13777.                 pxya[4]:=clip[2];
  13778.                 pxya[5]:=clip[3];
  13779.                 pxya[6]:=clip[0];
  13780.                 pxya[7]:=clip[3];
  13781.                 pxya[8]:=pxya[0];
  13782.                 pxya[9]:=pxya[1];
  13783.                 v_pline(vdiHandle,5,pxya);
  13784.                 dec(clip[0]);
  13785.                 dec(clip[1]);
  13786.                 inc(clip[2]);
  13787.                 inc(clip[3]);
  13788.                 pxya[0]:=clip[0];
  13789.                 pxya[1]:=clip[1];
  13790.                 pxya[2]:=clip[2];
  13791.                 pxya[3]:=clip[1];
  13792.                 pxya[4]:=clip[2];
  13793.                 pxya[5]:=clip[3];
  13794.                 pxya[6]:=clip[0];
  13795.                 pxya[7]:=clip[3];
  13796.                 pxya[8]:=pxya[0];
  13797.                 pxya[9]:=pxya[1];
  13798.                 v_pline(vdiHandle,5,pxya);
  13799.                 if bTst(parm^.pb_tree^[parm^.pb_obj].ob_flags,DEFAULT) then
  13800.                     begin
  13801.                         dec(clip[0]);
  13802.                         dec(clip[1]);
  13803.                         inc(clip[2]);
  13804.                         inc(clip[3]);
  13805.                         pxya[0]:=clip[0];
  13806.                         pxya[1]:=clip[1];
  13807.                         pxya[2]:=clip[2];
  13808.                         pxya[3]:=clip[1];
  13809.                         pxya[4]:=clip[2];
  13810.                         pxya[5]:=clip[3];
  13811.                         pxya[6]:=clip[0];
  13812.                         pxya[7]:=clip[3];
  13813.                         pxya[8]:=pxya[0];
  13814.                         pxya[9]:=pxya[1];
  13815.                         v_pline(vdiHandle,5,pxya)
  13816.                     end;
  13817.                 gem.vswr_mode(vdiHandle,MD_TRANS);
  13818.                 if bTst(parm^.pr_currstate,DISABLED) then gem.vst_effects(vdiHandle,TF_LIGHTENED);
  13819.                 v_gtext(vdiHandle,tx,ty,btn);
  13820.                 if scpos>0 then
  13821.                     begin
  13822.                         if bTst(parm^.pr_currstate,DISABLED) then gem.vst_effects(vdiHandle,TF_LIGHTENED or TF_UNDERLINED)
  13823.                         else
  13824.                             begin
  13825.                                 gem.vst_effects(vdiHandle,TF_UNDERLINED);
  13826.                                 gem.vst_color(vdihandle,Red)
  13827.                             end;
  13828.                         v_gtext(vdiHandle,tx+(scpos-1)*Attr.charSWidth,ty,' ')
  13829.                     end;
  13830.                 RestoreVWrk
  13831.             end;
  13832.         DrawPushButton:=NORMAL
  13833.     end;
  13834.  
  13835.  
  13836. procedure UpdateGPValues;
  13837.  
  13838.     begin
  13839.     end;
  13840.  
  13841.  
  13842. function GEMVersion: word;
  13843.  
  13844.     begin
  13845.         if Application<>nil then GEMVersion:=GEM_pb.global[0]
  13846.         else
  13847.             GEMVersion:=0
  13848.     end;
  13849.  
  13850.  
  13851. function IsDesktopActive: boolean;
  13852.     var p     : pointer;
  13853.         fname : string;
  13854.         st,sid: integer;
  13855.  
  13856.     begin
  13857.         if agi.ApplSearch then
  13858.             begin
  13859.                 wind_update(BEG_UPDATE);
  13860.                 appl_search(2,fname,st,sid);
  13861.                 with AES_pb do
  13862.                     begin
  13863.                         control^[0]:=13;
  13864.                         control^[1]:=0;
  13865.                         control^[2]:=1;
  13866.                         control^[3]:=1;
  13867.                         control^[4]:=0;
  13868.                         addrin^[0]:=nil
  13869.                     end;
  13870.                 _crystal(@AES_pb);
  13871.                 IsDesktopActive:=(sid=AES_pb.intout^[0]);
  13872.                 wind_update(END_UPDATE)
  13873.             end
  13874.         else
  13875.             begin
  13876.                 p:=GetOSHeaderPtr;
  13877.                 if TOSVersion<$0102 then
  13878.                     begin
  13879.                         if (PWord(longint(p)+28)^ div 2)=SPA then p:=pointer($873c)
  13880.                         else
  13881.                             p:=pointer($602c)
  13882.                     end
  13883.                 else
  13884.                     p:=PPointer(longint(p)+40)^;
  13885.                 IsDesktopActive:=(PDPtr(PPointer(p)^)^.p_tlen=0)
  13886.             end
  13887.     end;
  13888.  
  13889.  
  13890. procedure GetQSB(var p: pointer; var len: longint);
  13891.     var w1,w2,w3,w4: integer;
  13892.  
  13893.     begin
  13894.         if Application<>nil then
  13895.             if Application^.MultiTOS then
  13896.                 begin
  13897.                     p:=nil;
  13898.                     len:=0;
  13899.                     exit
  13900.                 end;
  13901.         wind_get(DESK,WF_SCREEN,w1,w2,w3,w4);
  13902.         p:=Ptr(word(w1),word(w2));
  13903.         len:=longint(Ptr(word(w3),word(w4)));
  13904.         if (len=0) and (GEMVersion=$0120) then len:=8000
  13905.     end;
  13906.  
  13907.  
  13908. function GetTempDir: string;
  13909.  
  13910.     function gettemp(fn: string): boolean;
  13911.  
  13912.         begin
  13913.             gettemp:=false;
  13914.             fn:=GetEnv(fn);
  13915.             if length(fn)=0 then exit;
  13916.             StrPTrim(fn);
  13917.             if StrPLeft(fn,1)='\' then fn:=BootDevice+':'+fn;
  13918.             if StrPRight(StrPLeft(fn,2),1)<>':' then fn:=BootDevice+':\'+fn;
  13919.             if StrPRight(fn,1)<>'\' then fn:=fn+'\';
  13920.             if PathExist(fn) then
  13921.                 begin
  13922.                     gettemp:=true;
  13923.                     GetTempDir:=fn
  13924.                 end
  13925.         end;
  13926.  
  13927.     begin
  13928.         GetTempDir:=BootDevice+':\';
  13929.         if gettemp('TMPDIR') then exit;
  13930.         if gettemp('TEMPDIR') then exit;
  13931.         if gettemp('TMP') then exit;
  13932.         if gettemp('TEMP') then exit;
  13933.         if gettemp('TRASHDIR') then exit;
  13934.         if Application<>nil then
  13935.             with Application^ do
  13936.                 if apPath<>nil then GetTempDir:=apPath^
  13937.     end;
  13938.  
  13939.  
  13940. function GetHomeDir(RootDefault: boolean): string;
  13941.     var fn: string;
  13942.  
  13943.     begin
  13944.         if RootDefault then GetHomeDir:=BootDevice+':\'
  13945.         else
  13946.             begin
  13947.                 GetHomeDir:='';
  13948.                 if Application<>nil then
  13949.                     if Application^.apPath<>nil then GetHomeDir:=Application^.apPath^
  13950.             end;
  13951.         fn:=GetEnv('HOME');
  13952.         if length(fn)=0 then exit;
  13953.         StrPTrim(fn);
  13954.         if StrPLeft(fn,1)='\' then fn:=BootDevice+':'+fn;
  13955.         if StrPRight(StrPLeft(fn,2),1)<>':' then fn:=BootDevice+':\'+fn;
  13956.         if StrPRight(fn,1)<>'\' then fn:=fn+'\';
  13957.         if PathExist(fn) then GetHomeDir:=fn
  13958.     end;
  13959.  
  13960.  
  13961. function FileSelect(AParent: PWindow; ATitle,AMask: string; var APath,AFile: string; ForceExist: boolean): boolean;
  13962.     label _again;
  13963.  
  13964.     var fname,fpath,npath,dmy: string;
  13965.         exitButton,ret       : integer;
  13966.         dummy                : longint;
  13967.         olddta               : DTAPtr;
  13968.         newdta               : DTA;
  13969.  
  13970.     begin
  13971.         wind_update(BEG_UPDATE);
  13972.         wind_update(BEG_MCTRL);
  13973.         olddta:=FGetdta;
  13974.         Fsetdta(@newdta);
  13975.         FileSelect:=false;
  13976.         if length(APath)=0 then dgetpath(fpath,0)
  13977.         else
  13978.             fpath:=APath;
  13979.         if StrPRight(fpath,1)<>'\' then fpath:=fpath+'\';
  13980.         if StrPRight(StrPLeft(fpath,2),1)<>':' then fpath:=chr(dgetdrv+65)+':'+fpath;
  13981.         if fpath[3]<>'\' then
  13982.             fpath:=StrPLeft(fpath,2)+'\'+StrPRight(fpath,length(fpath)-2);
  13983.         if length(AMask)=0 then fpath:=fpath+'*.*'
  13984.         else
  13985.             fpath:=fpath+AMask;
  13986.         fname:=AFile;
  13987.         _again:
  13988.         if ((GEMVersion>=$0140) and (GEMVersion<$0200)) or (GEMVersion>=$0300) or GetCookie('FSEL',dummy) then
  13989.             ret:=fsel_exinput(fpath,fname,exitButton,ATitle)
  13990.         else
  13991.             ret:=fsel_input(fpath,fname,exitButton);
  13992.         if (exitButton=1) and (ret<>0) and (length(fname)>0) then
  13993.             begin
  13994.                 dummy:=pos('.',AMask);
  13995.                 if ((pos('.',fname)=0) or (StrPRight(fname,1)='.')) and Between(dummy,1,length(AMask)-1) then
  13996.                     begin
  13997.                         dmy:=StrPRight(AMask,length(AMask)-dummy);
  13998.                         if (pos('?',dmy)=0) and (pos('*',dmy)=0) then
  13999.                             begin
  14000.                                 if StrPRight(fname,1)='.' then fname:=fname+dmy
  14001.                                 else
  14002.                                     fname:=fname+'.'+dmy
  14003.                             end
  14004.                     end;
  14005.                 npath:=StrPLeft(fpath,RPos('\',fpath));
  14006.                 if ForceExist then
  14007.                     if not(Exist(npath+fname)) then
  14008.                         begin
  14009.                             if Application<>nil then
  14010.                                 with Application^ do
  14011.                                     begin
  14012.                                         if (Attr.Country=FRG) or (Attr.Country=SWG) then Alert(nil,1,NOTE,'"'+fname+'" existiert nicht.','  &OK  ')
  14013.                                         else
  14014.                                             Alert(nil,1,NOTE,'"'+fname+'" does not exist.','  &OK  ')
  14015.                                     end
  14016.                             else
  14017.                                 form_alert(1,'[1][ | | |"'+fname+'" existiert nicht.  ][   OK   ]');
  14018.                             goto _again
  14019.                         end;
  14020.                 APath:=npath;
  14021.                 AFile:=fname;
  14022.                 FileSelect:=true
  14023.             end;
  14024.         Fsetdta(olddta);
  14025.         wind_update(END_MCTRL);
  14026.         wind_update(END_UPDATE);
  14027.         if Application<>nil then
  14028.             Application^.RestoreModalDialog(AParent)
  14029.     end;
  14030.  
  14031.  
  14032. procedure checkinfpath(var FileName: string);
  14033.     var pfad: string;
  14034.  
  14035.     begin
  14036.         if pos('\',FileName)>0 then exit;
  14037.         if Application=nil then exit;
  14038.         if bTst(Application^.Attr.Style,as_UseHomeDir) then
  14039.             if length(GetEnv('HOME'))>0 then
  14040.                 begin
  14041.                     pfad:=GetHomeDir(false)+'defaults\';
  14042.                     if PathExist(pfad) then
  14043.                         begin
  14044.                             FileName:=pfad+FileName;
  14045.                             exit
  14046.                         end
  14047.                 end;
  14048.         if Application^.apPath<>nil then FileName:=Application^.apPath^+FileName
  14049.     end;
  14050.  
  14051.  
  14052. function OpenPrivateProfile(FileName: string): boolean;
  14053.     label _error,_exit;
  14054.  
  14055.     var f: text;
  14056.         t: string;
  14057.  
  14058.     begin
  14059.         OpenPrivateProfile:=false;
  14060.         if profile<>nil then exit;
  14061.         checkinfpath(FileName);
  14062.         if StrPLower(GetHomeDir(true))+SYSPROFILE=StrPLower(FileName) then exit;
  14063.         profilename:=NewStr(StrPLower(FileName));
  14064.         if profilename=nil then exit;
  14065.         new(profile,Init(50,25));
  14066.         if profile=nil then
  14067.             begin
  14068.                 DisposeStr(profilename);
  14069.                 exit
  14070.             end;
  14071.         profilechng:=false;
  14072.         if Exist(FileName) then
  14073.             begin
  14074.                 wind_update(BEG_UPDATE);
  14075.                 BusyMouse;
  14076.                 assign(f,FileName);
  14077.                 reset(f);
  14078.                 if ioresult<>0 then goto _exit;
  14079.                 while not(eof(f)) do
  14080.                     begin
  14081.                         if ioresult<>0 then goto _error;
  14082.                         readln(f,t);
  14083.                         profile^.Insert(ChrNew(StrPTrimF(t)))
  14084.                     end;
  14085.                 _error:
  14086.                 close(f);
  14087.                 ioresult;
  14088.                 OpenPrivateProfile:=true;
  14089.                 _exit:
  14090.                 ArrowMouse;
  14091.                 wind_update(END_UPDATE)
  14092.             end
  14093.     end;
  14094.  
  14095.  
  14096. function SavePrivateProfile: boolean;
  14097.     label _exit,_close;
  14098.  
  14099.     var tfile : string;
  14100.         f,ftmp: text;
  14101.         q     : longint;
  14102.  
  14103.     begin
  14104.         SavePrivateProfile:=false;
  14105.         if profile<>nil then
  14106.             begin
  14107.                 if profilechng then
  14108.                     begin
  14109.                         wind_update(BEG_UPDATE);
  14110.                         BusyMouse;
  14111.                         tfile:=GetPath(profilename^)+GetTempFilename;
  14112.                         assign(ftmp,tfile);
  14113.                         assign(f,profilename^);
  14114.                         rewrite(ftmp);
  14115.                         if ioresult<>0 then goto _exit;
  14116.                         if profile^.Count>0 then
  14117.                             for q:=0 to profile^.Count-1 do
  14118.                                 if profile^.At(q)<>nil then
  14119.                                     begin
  14120.                                         if ioresult<>0 then goto _close;
  14121.                                         writeln(ftmp,PChar(profile^.At(q)))
  14122.                                     end;
  14123.                         _close:
  14124.                         close(ftmp);
  14125.                         ioresult;
  14126.                         erase(f);
  14127.                         ioresult;
  14128.                         rename(ftmp,profilename^);
  14129.                         if ioresult=0 then
  14130.                             begin
  14131.                                 SavePrivateProfile:=true;
  14132.                                 profilechng:=false
  14133.                             end;
  14134.                         _exit:
  14135.                         ArrowMouse;
  14136.                         wind_update(END_UPDATE)
  14137.                     end
  14138.                 else
  14139.                     SavePrivateProfile:=true
  14140.             end
  14141.     end;
  14142.  
  14143.  
  14144. function ClosePrivateProfile: boolean;
  14145.  
  14146.     begin
  14147.         if profile<>nil then
  14148.             begin
  14149.                 ClosePrivateProfile:=SavePrivateProfile;
  14150.                 dispose(profile,Done);
  14151.                 DisposeStr(profilename);
  14152.                 profile:=nil
  14153.             end
  14154.         else
  14155.             ClosePrivateProfile:=false
  14156.     end;
  14157.  
  14158.  
  14159. function WritePrivateProfileString(AppName,KeyName,Value,FileName: string): boolean;
  14160.     label _exit,_error,_closeall,_fertig;
  14161.  
  14162.     var f,ftmp        : text;
  14163.         t,ca,key,aname,
  14164.         kname,tfile   : string;
  14165.         p             : integer;
  14166.         found,rblk    : boolean;
  14167.         q             : longint;
  14168.         rem           : string[1];
  14169.  
  14170.     begin
  14171.         aname:=StrPUpper(StrPTrimF(AppName));
  14172.         kname:=StrPUpper(StrPTrimF(KeyName));
  14173.         WritePrivateProfileString:=false;
  14174.         if (length(aname)=0) or (length(kname)=0) then exit;
  14175.         checkinfpath(FileName);
  14176.         ca:='';
  14177.         found:=false;
  14178.         rblk:=false;
  14179.         if profile<>nil then
  14180.             if profilename^=StrPLower(FileName) then
  14181.                 begin
  14182.                     q:=0;
  14183.                     while q<profile^.Count do
  14184.                         begin
  14185.                             if profile^.At(q)=nil then
  14186.                                 begin
  14187.                                     inc(q);
  14188.                                     continue
  14189.                                 end;
  14190.                             t:=StrPTrimF(StrPas(profile^.At(q)));
  14191.                             if StrPLeft(t,2)='##' then
  14192.                                 begin
  14193.                                     rblk:=not(rblk);
  14194.                                     inc(q);
  14195.                                     continue
  14196.                                 end;
  14197.                             rem:=StrPLeft(t,1);
  14198.                             if (rem=';') or (rem='#') or rblk then
  14199.                                 begin
  14200.                                     inc(q);
  14201.                                     continue
  14202.                                 end;
  14203.                             if (StrPLeft(t,1)='[') and (StrPRight(t,1)=']') then
  14204.                                 ca:=StrPUpper(copy(t,2,length(t)-2))
  14205.                             else
  14206.                                 if ca=aname then
  14207.                                     begin
  14208.                                         if length(t)=0 then
  14209.                                             begin
  14210.                                                 if length(Value)>0 then
  14211.                                                     profile^.AtInsert(q,ChrNew(StrPTrimF(KeyName)+'='+Value));
  14212.                                                 found:=true;
  14213.                                                 goto _fertig
  14214.                                             end
  14215.                                         else
  14216.                                             begin
  14217.                                                 p:=pos('=',t);
  14218.                                                 if p>0 then
  14219.                                                     if StrPUpper(StrPLeft(t,p-1))=kname then
  14220.                                                         begin
  14221.                                                             if length(Value)>0 then
  14222.                                                                 begin
  14223.                                                                     profile^.FreeItem(profile^.At(q));
  14224.                                                                     profile^.AtPut(q,ChrNew(StrPTrimF(KeyName)+'='+Value))
  14225.                                                                 end
  14226.                                                             else
  14227.                                                                 profile^.AtFree(q);
  14228.                                                             found:=true;
  14229.                                                             goto _fertig
  14230.                                                         end
  14231.                                             end
  14232.                                     end;
  14233.                             inc(q)
  14234.                         end;
  14235.                     _fertig:
  14236.                     if not(found) then
  14237.                         begin
  14238.                             if rblk then profile^.Insert(ChrNew('##'));
  14239.                             if ca<>aname then profile^.Insert(ChrNew('['+StrPTrimF(AppName)+']'));
  14240.                             if length(Value)>0 then profile^.Insert(ChrNew(StrPTrimF(KeyName)+'='+Value));
  14241.                             profile^.Insert(ChrNew(''))
  14242.                         end;
  14243.                     WritePrivateProfileString:=true;
  14244.                     profilechng:=true;
  14245.                     exit
  14246.                 end;
  14247.         wind_update(BEG_UPDATE);
  14248.         tfile:=GetPath(FileName)+GetTempFilename;
  14249.         assign(f,FileName);
  14250.         if not(Exist(FileName)) then
  14251.             begin
  14252.                 rewrite(f);
  14253.                 if ioresult<>0 then goto _exit;
  14254.                 close(f)
  14255.             end;
  14256.         rename(f,tfile);
  14257.         if ioresult<>0 then goto _exit;
  14258.         assign(f,FileName);
  14259.         assign(ftmp,tfile);
  14260.         rewrite(f);
  14261.         if ioresult<>0 then goto _exit;
  14262.         reset(ftmp);
  14263.         if ioresult<>0 then goto _error;
  14264.         while not(eof(ftmp)) do
  14265.             begin
  14266.                 if ioresult<>0 then goto _closeall;
  14267.                 readln(ftmp,t);
  14268.                 StrPTrim(t);
  14269.                 if StrPLeft(t,2)='##' then
  14270.                     begin
  14271.                         rblk:=not(rblk);
  14272.                         writeln(f,t);
  14273.                         continue
  14274.                     end;
  14275.                 rem:=StrPLeft(t,1);
  14276.                 if found or rblk or (rem=';') or (rem='#') then writeln(f,t)
  14277.                 else
  14278.                     begin
  14279.                         if (StrPLeft(t,1)='[') and (StrPRight(t,1)=']') then
  14280.                             begin
  14281.                                 writeln(f,t);
  14282.                                 ca:=StrPUpper(copy(t,2,length(t)-2))
  14283.                             end
  14284.                         else
  14285.                             begin
  14286.                                 if ca=aname then
  14287.                                     begin
  14288.                                         if length(t)=0 then
  14289.                                             begin
  14290.                                                 if length(Value)>0 then
  14291.                                                     writeln(f,StrPTrimF(KeyName)+'='+Value);
  14292.                                                 writeln(f);
  14293.                                                 found:=true
  14294.                                             end
  14295.                                         else
  14296.                                             begin
  14297.                                                 p:=pos('=',t);
  14298.                                                 if p>0 then
  14299.                                                     begin
  14300.                                                         if StrPUpper(StrPLeft(t,p-1))=kname then
  14301.                                                             begin
  14302.                                                                 if length(Value)>0 then
  14303.                                                                     writeln(f,StrPTrimF(KeyName)+'='+Value);
  14304.                                                                 found:=true
  14305.                                                             end
  14306.                                                         else
  14307.                                                             writeln(f,t)
  14308.                                                     end
  14309.                                             end
  14310.                                     end
  14311.                                 else
  14312.                                     writeln(f,t)
  14313.                             end
  14314.                     end
  14315.             end;
  14316.         if not(found) then
  14317.             begin
  14318.                 if rblk then writeln(f,'##');
  14319.                 if ca<>aname then writeln(f,'['+StrPTrimF(AppName)+']');
  14320.                 if length(Value)>0 then writeln(f,StrPTrimF(KeyName)+'='+Value);
  14321.                 writeln(f)
  14322.             end;
  14323.         WritePrivateProfileString:=true;
  14324.         _closeall:
  14325.         close(ftmp);
  14326.         _error:
  14327.         close(f);
  14328.         erase(ftmp);
  14329.         _exit:
  14330.         wind_update(END_UPDATE);
  14331.         ioresult
  14332.     end;
  14333.  
  14334.  
  14335. function WritePrivateProfileInt(AppName,KeyName: string; Value: longint; FileName: string): boolean;
  14336.  
  14337.     begin
  14338.         WritePrivateProfileInt:=WritePrivateProfileString(AppName,KeyName,ltoa(Value),FileName)
  14339.     end;
  14340.  
  14341.  
  14342. function GetPrivateProfileString(AppName,KeyName,Default,FileName: string): string;
  14343.     label _exit,_error,_default;
  14344.  
  14345.     var f   : text;
  14346.         t,ca: string;
  14347.         p   : integer;
  14348.         q   : longint;
  14349.         rem : string[1];
  14350.         rblk: boolean;
  14351.  
  14352.     begin
  14353.         AppName:=StrPUpper(StrPTrimF(AppName));
  14354.         KeyName:=StrPUpper(StrPTrimF(KeyName));
  14355.         if (length(AppName)=0) or (length(KeyName)=0) then goto _default;
  14356.         checkinfpath(FileName);
  14357.         ca:='';
  14358.         rblk:=false;
  14359.         if profile<>nil then
  14360.             if profilename^=StrPLower(FileName) then
  14361.                 begin
  14362.                     q:=0;
  14363.                     while q<profile^.Count do
  14364.                         begin
  14365.                             if profile^.At(q)=nil then
  14366.                                 begin
  14367.                                     inc(q);
  14368.                                     continue
  14369.                                 end;
  14370.                             t:=StrPTrimF(StrPas(profile^.At(q)));
  14371.                             if StrPLeft(t,2)='##' then
  14372.                                 begin
  14373.                                     rblk:=not(rblk);
  14374.                                     inc(q);
  14375.                                     continue
  14376.                                 end;
  14377.                             if rblk then
  14378.                                 begin
  14379.                                     inc(q);
  14380.                                     continue
  14381.                                 end;
  14382.                             if (StrPLeft(t,1)='[') and (StrPRight(t,1)=']') then
  14383.                                 ca:=StrPUpper(copy(t,2,length(t)-2))
  14384.                             else
  14385.                                 begin
  14386.                                     rem:=StrPLeft(t,1);
  14387.                                     if (rem<>';') and (rem<>'#') then
  14388.                                         begin
  14389.                                             p:=pos('=',t);
  14390.                                             if p>0 then
  14391.                                                 if StrPUpper(StrPLeft(t,p-1))=KeyName then
  14392.                                                     if ca=AppName then
  14393.                                                         begin
  14394.                                                             GetPrivateProfileString:=StrPRight(t,length(t)-p);
  14395.                                                             exit
  14396.                                                         end
  14397.                                         end
  14398.                                 end;
  14399.                             inc(q)
  14400.                         end;
  14401.                     goto _default
  14402.                 end;
  14403.         wind_update(BEG_UPDATE);
  14404.         assign(f,FileName);
  14405.         reset(f);
  14406.         if ioresult<>0 then goto _exit;
  14407.         while not(eof(f)) do
  14408.             begin
  14409.                 if ioresult<>0 then goto _error;
  14410.                 readln(f,t);
  14411.                 StrPTrim(t);
  14412.                 if StrPLeft(t,2)='##' then
  14413.                     begin
  14414.                         rblk:=not(rblk);
  14415.                         continue
  14416.                     end;
  14417.                 if rblk then continue;
  14418.                 if (StrPLeft(t,1)='[') and (StrPRight(t,1)=']') then
  14419.                     ca:=StrPUpper(copy(t,2,length(t)-2))
  14420.                 else
  14421.                     begin
  14422.                         rem:=StrPLeft(t,1);
  14423.                         if (rem<>';') and (rem<>'#') then
  14424.                             begin
  14425.                                 p:=pos('=',t);
  14426.                                 if p>0 then
  14427.                                     if StrPUpper(StrPLeft(t,p-1))=KeyName then
  14428.                                         if ca=AppName then
  14429.                                             begin
  14430.                                                 GetPrivateProfileString:=StrPRight(t,length(t)-p);
  14431.                                                 close(f);
  14432.                                                 wind_update(END_UPDATE);
  14433.                                                 exit
  14434.                                             end
  14435.                             end
  14436.                     end
  14437.             end;
  14438.         _error:
  14439.         close(f);
  14440.         ioresult;
  14441.         _exit:
  14442.         wind_update(END_UPDATE);
  14443.         _default:
  14444.         GetPrivateProfileString:=Default
  14445.     end;
  14446.  
  14447.  
  14448. function GetPrivateProfileInt(AppName,KeyName: string; Default: longint; FileName: string): longint;
  14449.     var sval : string;
  14450.  
  14451.     begin
  14452.         sval:=GetPrivateProfileString(AppName,KeyName,'',FileName);
  14453.         if sval='' then GetPrivateProfileInt:=Default
  14454.         else
  14455.             GetPrivateProfileInt:=atol(sval)
  14456.     end;
  14457.  
  14458.  
  14459. function WriteProfileString(AppName,KeyName,Value: string): boolean;
  14460.  
  14461.     begin
  14462.         WriteProfileString:=WritePrivateProfileString(AppName,KeyName,Value,GetHomeDir(true)+SYSPROFILE)
  14463.     end;
  14464.  
  14465.  
  14466. function WriteProfileInt(AppName,KeyName: string; Value: longint): boolean;
  14467.  
  14468.     begin
  14469.         WriteProfileInt:=WritePrivateProfileInt(AppName,KeyName,Value,GetHomeDir(true)+SYSPROFILE)
  14470.     end;
  14471.  
  14472.  
  14473. function GetProfileString(AppName,KeyName,Default: string): string;
  14474.  
  14475.     begin
  14476.         GetProfileString:=GetPrivateProfileString(AppName,KeyName,Default,GetHomeDir(true)+SYSPROFILE)
  14477.     end;
  14478.  
  14479.  
  14480. function GetProfileInt(AppName,KeyName: string; Default: longint): longint;
  14481.  
  14482.     begin
  14483.         GetProfileInt:=GetPrivateProfileInt(AppName,KeyName,Default,GetHomeDir(true)+SYSPROFILE)
  14484.     end;
  14485.  
  14486.  
  14487. function graf_mouse(gr_monumber: word; gr_mofaddr: MFORMPtr): integer;
  14488.     const CMAX = IDC_SLICE4;
  14489.                 GOCrs : array[IDC_WAIT..CMAX] of MFORM =
  14490.                ((mf_xhot: 8; mf_yhot: 8; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  14491.                  mf_mask: (32767,16385,16385,28667,28027,14006,7020,3544,3416,7148,14006,27995,27307,16385,16385,32767);
  14492.                  mf_data: (0,16382,16382,4100,4740,2376,1168,544,672,1040,2376,4772,5460,16382,16382,0)),
  14493.                 (mf_xhot: 1; mf_yhot: 1; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  14494.                  mf_mask: (32760,-32764,-28702,-28895,-28895,-28895,-32767,-32767,-24583,-27303,-25943,-27303,-25943,-24583,-32767,32766);
  14495.                  mf_data: (0,32760,28700,28894,28894,28894,32766,32766,24582,27302,25942,27302,25942,16390,32766,0)),
  14496.                 (mf_xhot: 0; mf_yhot: 0; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  14497.                  mf_mask: (-16130,-24125,-28287,-30311,-31247,-31773,-32313,-32625,-32743,-31871,-27709,-22017,-13849,-31513,1278,896);
  14498.                  mf_data: (0,16444,24702,28774,30734,31772,32312,32624,32742,31870,27708,17920,1560,792,768,0)),
  14499.                 (mf_xhot: 1; mf_yhot: 14; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  14500.                  mf_mask: (24,36,74,153,309,618,1236,2472,4944,9888,9536,23168,22784,-31232,-26624,-8192);
  14501.                  mf_data: (0,24,52,102,202,404,808,1616,3232,6464,6784,9472,9728,30720,24576,0)),
  14502.                 (mf_xhot: 1; mf_yhot: 1; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  14503.                  mf_mask: (-512,-32512,-16768,-20672,-18528,23504,11752,5876,3066,1409,701,317,129,127,0,0);
  14504.                  mf_data: (0,32256,16640,20608,18496,9248,4624,2312,1028,638,322,194,126,0,0,0)),
  14505.                 (mf_xhot: 1; mf_yhot: 1; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  14506.                  mf_mask: (-8192,-28672,-30720,17408,8704,4352,2718,1377,685,333,417,542,720,720,528,480);
  14507.                  mf_data: (0,24576,28672,14336,7168,3584,1280,670,338,178,94,480,288,288,480,0)),
  14508.                 (mf_xhot: 1; mf_yhot: 1; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  14509.                  mf_mask: (24576,-28672,-20736,20608,11328,11040,10128,10192,5064,2536,1256,620,290,138,98,28);
  14510.                  mf_data: (0,24576,20480,12032,4992,5312,6240,6176,3120,1552,784,400,220,116,28,0)),
  14511.                             (mf_xhot: 7; mf_yhot: 7; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  14512.                              mf_mask: (960,3120,4296,8436,16634,16634,-32515,-32515,-16639,-16639,24322,24322,12036,4872,3120,960);
  14513.                              mf_data: (0,960,3888,7944,16132,16132,32514,32514,16638,16638,8444,8444,4344,3312,960,0)),
  14514.                             (mf_xhot: 7; mf_yhot: 7; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  14515.                              mf_mask: (960,3120,4104,8196,20490,22554,-17347,-16771,-16771,-17347,22554,20490,8196,4104,3120,960);
  14516.                              mf_data: (0,960,4080,8184,12276,10212,17346,16770,16770,17346,10212,12276,8184,4080,960,0)),
  14517.                             (mf_xhot: 7; mf_yhot: 7; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  14518.                              mf_mask: (960,3120,4872,12036,24322,24322,-16639,-16639,-32515,-32515,16634,16634,8436,4296,3120,960);
  14519.                              mf_data: (0,960,3312,4344,8444,8444,16638,16638,32514,32514,16132,16132,7944,3888,960,0)),
  14520.                             (mf_xhot: 7; mf_yhot: 7; mf_nplanes: 1; mf_fg: 0; mf_bg: 1;
  14521.                              mf_mask: (960,3120,5064,12276,18402,17346,-32383,-32767,-32767,-32383,17346,18402,12276,5064,3120,960);
  14522.                              mf_data: (0,960,3120,4104,14364,15420,32382,32766,32766,32382,15420,14364,4104,3120,960,0)));
  14523.  
  14524.     var ret: integer;
  14525.         frc: word;
  14526.  
  14527.     begin
  14528.         if bTst(gr_monumber,MFORCE) and Application^.MultiTOS then frc:=MFORCE
  14529.             else frc:=0;
  14530.         gr_monumber:=gr_monumber and $7fff;
  14531.         if gr_monumber=USER_DEF then
  14532.             begin
  14533.                 if gr_mofaddr<>nil then
  14534.                     begin
  14535.                         ret:=gem.graf_mouse(frc or USER_DEF,gr_mofaddr);
  14536.                         if ret<>0 then
  14537.                             begin
  14538.                                 mlnr:=GP.mnr;
  14539.                                 mlform:=GP.mform;
  14540.                                 GP.mnr:=USER_DEF;
  14541.                                 GP.mform:=gr_mofaddr^
  14542.                             end
  14543.                     end
  14544.                 else
  14545.                     ret:=0
  14546.             end
  14547.         else
  14548.             begin
  14549.                 if (gr_monumber>=IDC_WAIT) and (gr_monumber<=CMAX) then
  14550.                     begin
  14551.                         ret:=gem.graf_mouse(frc or USER_DEF,@GOCrs[gr_monumber]);
  14552.                         if (ret<>0) and (longint(gr_mofaddr)<>1) then
  14553.                             begin
  14554.                                 mlnr:=GP.mnr;
  14555.                                 mlform:=GP.mform;
  14556.                                 GP.mnr:=USER_DEF;
  14557.                                 GP.mform:=GOCrs[gr_monumber]
  14558.                             end
  14559.                     end
  14560.                 else
  14561.                     begin
  14562.                         if (gr_monumber>M_ON) and not(Application^.MultiTOS) then ret:=0
  14563.                         else
  14564.                             ret:=gem.graf_mouse(frc or gr_monumber,nil);
  14565.                         if (ret<>0) and (gr_monumber<M_OFF) and (longint(gr_mofaddr)<>1) then
  14566.                             begin
  14567.                                 mlnr:=GP.mnr;
  14568.                                 mlform:=GP.mform;
  14569.                                 GP.mnr:=gr_monumber
  14570.                             end
  14571.                     end
  14572.             end;
  14573.         graf_mouse:=ret
  14574.     end;
  14575.  
  14576.  
  14577. function AppVHnd: integer;
  14578.  
  14579.     begin
  14580.         if Application<>nil then AppVHnd:=Application^.vdiHandle
  14581.             else AppVHnd:=0
  14582.     end;
  14583.  
  14584.  
  14585. function vswr_mode(handle,mode: integer): integer;
  14586.  
  14587.     begin
  14588.         if handle=AppVHnd then
  14589.             begin
  14590.                 GP.wrmode:=gem.vswr_mode(handle,mode);
  14591.                 vswr_mode:=GP.wrmode
  14592.             end
  14593.         else
  14594.             vswr_mode:=gem.vswr_mode(handle,mode)
  14595.     end;
  14596.  
  14597.  
  14598. procedure vsl_udsty(handle,pattern: integer);
  14599.  
  14600.     begin
  14601.         gem.vsl_udsty(handle,pattern);
  14602.         if handle=AppVHnd then GP.ludsty:=pattern
  14603.     end;
  14604.  
  14605.  
  14606. function vsl_type(handle,style: integer): integer;
  14607.  
  14608.     begin
  14609.         if handle=AppVHnd then
  14610.             begin
  14611.                 GP.ltype:=gem.vsl_type(handle,style);
  14612.                 vsl_type:=GP.ltype
  14613.             end
  14614.         else
  14615.             vsl_type:=gem.vsl_type(handle,style)
  14616.     end;
  14617.  
  14618.  
  14619. function vsl_width(handle,width: integer): integer;
  14620.  
  14621.     begin
  14622.         if handle=AppVHnd then
  14623.             begin
  14624.                 GP.lwidth:=gem.vsl_width(handle,width);
  14625.                 vsl_width:=GP.lwidth
  14626.             end
  14627.         else
  14628.             vsl_width:=gem.vsl_width(handle,width)
  14629.     end;
  14630.  
  14631.  
  14632. function vsl_color(handle,color_index: integer): integer;
  14633.  
  14634.     begin
  14635.         if handle=AppVHnd then
  14636.             begin
  14637.                 GP.lcolor:=gem.vsl_color(handle,color_index);
  14638.                 vsl_color:=GP.lcolor
  14639.             end
  14640.         else
  14641.             vsl_color:=gem.vsl_color(handle,color_index)
  14642.     end;
  14643.  
  14644.  
  14645. procedure vsl_ends(handle,beg_style,end_style: integer);
  14646.  
  14647.     begin
  14648.         gem.vsl_ends(handle,beg_style,end_style);
  14649.         if handle=AppVHnd then
  14650.             begin
  14651.                 GP.lendsb:=beg_style;
  14652.                 GP.lendse:=end_style
  14653.             end
  14654.     end;
  14655.  
  14656.  
  14657. function vsm_type(handle,symbol: integer): integer;
  14658.  
  14659.     begin
  14660.         if handle=AppVHnd then
  14661.             begin
  14662.                 GP.mtype:=gem.vsm_type(handle,symbol);
  14663.                 vsm_type:=GP.mtype
  14664.             end
  14665.         else
  14666.             vsm_type:=gem.vsm_type(handle,symbol)
  14667.     end;
  14668.  
  14669.  
  14670. function vsm_height(handle,height: integer): integer;
  14671.  
  14672.     begin
  14673.         if handle=AppVHnd then
  14674.             begin
  14675.                 GP.mheight:=gem.vsm_height(handle,height);
  14676.                 vsm_height:=GP.mheight
  14677.             end
  14678.         else
  14679.             vsm_height:=gem.vsm_height(handle,height)
  14680.     end;
  14681.  
  14682.  
  14683. function vsm_color(handle,color_index: integer): integer;
  14684.  
  14685.     begin
  14686.         if handle=AppVHnd then
  14687.             begin
  14688.                 GP.mcolor:=gem.vsm_color(handle,color_index);
  14689.                 vsm_color:=GP.mcolor
  14690.             end
  14691.         else
  14692.             vsm_color:=gem.vsm_color(handle,color_index)
  14693.     end;
  14694.  
  14695.  
  14696. function vst_font(handle,font: integer): integer;
  14697.  
  14698.     begin
  14699.         if handle=AppVHnd then
  14700.             begin
  14701.                 GP.font:=gem.vst_font(handle,font);
  14702.                 vst_font:=GP.font
  14703.             end
  14704.         else
  14705.             vst_font:=gem.vst_font(handle,font)
  14706.     end;
  14707.  
  14708.  
  14709. function vst_point(handle,point: integer; var char_width,char_height,cell_width,cell_height: integer): integer;
  14710.  
  14711.     begin
  14712.         if point<0 then vst_point:=-1
  14713.         else
  14714.             begin
  14715.                 if handle=AppVHnd then
  14716.                     with GP do
  14717.                         begin
  14718.                             tpoint:=gem.vst_point(handle,point,charWidth,charHeight,boxWidth,boxHeight);
  14719.                             char_width:=charWidth;
  14720.                             char_height:=charHeight;
  14721.                             cell_width:=boxWidth;
  14722.                             cell_height:=boxHeight;
  14723.                             vst_point:=tpoint;
  14724.                             theight:=-1
  14725.                         end
  14726.                 else
  14727.                     vst_point:=gem.vst_point(handle,point,char_width,char_height,cell_width,cell_height)
  14728.             end
  14729.     end;
  14730.  
  14731.  
  14732. procedure vst_height(handle,height: integer; var char_width,char_height,cell_width,cell_height: integer);
  14733.  
  14734.     begin
  14735.         if height>=0 then
  14736.             begin
  14737.                 gem.vst_height(handle,height,char_width,char_height,cell_width,cell_height);
  14738.                 if handle=AppVHnd then
  14739.                     with GP do
  14740.                         begin
  14741.                             charWidth:=char_width;
  14742.                             charHeight:=char_height;
  14743.                             boxWidth:=cell_width;
  14744.                             boxHeight:=cell_height;
  14745.                             theight:=height;
  14746.                             tpoint:=-1
  14747.                         end
  14748.             end
  14749.     end;
  14750.  
  14751.  
  14752. function vst_rotation(handle,angle: integer): integer;
  14753.  
  14754.     begin
  14755.         if handle=AppVHnd then
  14756.             begin
  14757.                 GP.trotation:=gem.vst_rotation(handle,angle);
  14758.                 vst_rotation:=GP.trotation
  14759.             end
  14760.         else
  14761.             vst_rotation:=gem.vst_rotation(handle,angle)
  14762.     end;
  14763.  
  14764.  
  14765. function vst_effects(handle,effect: integer): integer;
  14766.  
  14767.     begin
  14768.         if handle=AppVHnd then
  14769.             begin
  14770.                 GP.teffects:=gem.vst_effects(handle,effect);
  14771.                 vst_effects:=GP.teffects
  14772.             end
  14773.         else
  14774.             vst_effects:=gem.vst_effects(handle,effect)
  14775.     end;
  14776.  
  14777.  
  14778. procedure vst_alignment(handle,hor_in,vert_in: integer; var hor_out,vert_out: integer);
  14779.  
  14780.     begin
  14781.         gem.vst_alignment(handle,hor_in,vert_in,hor_out,vert_out);
  14782.         if handle=AppVHnd then
  14783.             begin
  14784.                 GP.horAlign:=hor_out;
  14785.                 GP.verAlign:=vert_out
  14786.             end
  14787.     end;
  14788.  
  14789.  
  14790. function vst_color(handle,color_index: integer): integer;
  14791.  
  14792.     begin
  14793.         if handle=AppVHnd then
  14794.             begin
  14795.                 GP.tcolor:=gem.vst_color(handle,color_index);
  14796.                 vst_color:=GP.tcolor
  14797.             end
  14798.         else
  14799.             vst_color:=gem.vst_color(handle,color_index)
  14800.     end;
  14801.  
  14802.  
  14803. function vsf_interior(handle,style: integer): integer;
  14804.  
  14805.     begin
  14806.         if handle=AppVHnd then
  14807.             begin
  14808.                 GP.finterior:=gem.vsf_interior(handle,style);
  14809.                 vsf_interior:=GP.finterior
  14810.             end
  14811.         else
  14812.             vsf_interior:=gem.vsf_interior(handle,style)
  14813.     end;
  14814.  
  14815.  
  14816. function vsf_style(handle,style_index: integer): integer;
  14817.  
  14818.     begin
  14819.         if handle=AppVHnd then
  14820.             begin
  14821.                 GP.fstyle:=gem.vsf_style(handle,style_index);
  14822.                 vsf_style:=GP.fstyle
  14823.             end
  14824.         else
  14825.             vsf_style:=gem.vsf_style(handle,style_index)
  14826.     end;
  14827.  
  14828.  
  14829. function vsf_color(handle,color_index: integer): integer;
  14830.  
  14831.     begin
  14832.         if handle=AppVHnd then
  14833.             begin
  14834.                 GP.fcolor:=gem.vsf_color(handle,color_index);
  14835.                 vsf_color:=GP.fcolor
  14836.             end
  14837.         else
  14838.             vsf_color:=gem.vsf_color(handle,color_index)
  14839.     end;
  14840.  
  14841.  
  14842. function vsf_perimeter(handle,per_vis: integer): integer;
  14843.  
  14844.     begin
  14845.         if handle=AppVHnd then
  14846.             begin
  14847.                 GP.fperimeter:=gem.vsf_perimeter(handle,per_vis);
  14848.                 vsf_perimeter:=GP.fperimeter
  14849.             end
  14850.         else
  14851.             vsf_perimeter:=gem.vsf_perimeter(handle,per_vis)
  14852.     end;
  14853.  
  14854.  
  14855. procedure vs_clip(handle,clipflag: integer; pxarray: ARRAY_4);
  14856.  
  14857.     begin
  14858.         gem.vs_clip(handle,clipflag,pxarray);
  14859.         if handle=AppVHnd then
  14860.             if clipflag<>CLIP_OFF then GP.clip:=pxarray
  14861.     end;
  14862.  
  14863.  
  14864. procedure vr_trnfm(handle: integer; psrcMFDB,pdesMFDB: MFDB);
  14865.     var dest: pointer;
  14866.         len : longint;
  14867.  
  14868.     begin
  14869.         if (psrcMFDB.fd_addr=pdesMFDB.fd_addr) and (psrcMFDB.fd_addr<>nil) then
  14870.             begin
  14871.                 len:=(psrcMFDB.fd_wdwidth*psrcMFDB.fd_h*psrcMFDB.fd_nplanes) shl 1;
  14872.                 getmem(dest,len);
  14873.                 if dest=nil then gem.vr_trnfm(handle,psrcMFDB,pdesMFDB)
  14874.                 else
  14875.                     begin
  14876.                         move(psrcMFDB.fd_addr^,dest^,len);
  14877.                         pdesMFDB.fd_addr:=psrcMFDB.fd_addr;
  14878.                         psrcMFDB.fd_addr:=dest;
  14879.                         gem.vr_trnfm(handle,psrcMFDB,pdesMFDB);
  14880.                         freemem(dest,len)
  14881.                     end
  14882.             end
  14883.         else
  14884.             gem.vr_trnfm(handle,psrcMFDB,pdesMFDB)
  14885.     end;
  14886.  
  14887.  
  14888. procedure vr_convert(handle: integer; psrcMFDB: MFDB; format: integer);
  14889.     var pdesMFDB: MFDB;
  14890.  
  14891.     begin
  14892.         if psrcMFDB.fd_stand<>format then
  14893.             begin
  14894.                 pdesMFDB:=psrcMFDB;
  14895.                 pdesMFDB.fd_stand:=format;
  14896.                 vr_trnfm(handle,psrcMFDB,pdesMFDB)
  14897.             end
  14898.     end;
  14899.  
  14900.  
  14901. procedure vdi_fix(var pfd: MFDB; theAddr: pointer; w,h: integer);
  14902.  
  14903.     begin
  14904.         with pfd do
  14905.             begin
  14906.                 fd_addr:=theaddr;
  14907.                 fd_wdwidth:=(w+15) shr 4;
  14908.                 fd_w:=w;
  14909.                 fd_h:=h;
  14910.                 fd_nplanes:=1;
  14911.                 fd_stand:=FF_STAND;
  14912.                 fd_r1:=0;
  14913.                 fd_r2:=0;
  14914.                 fd_r3:=0
  14915.             end
  14916.     end;
  14917.  
  14918.  
  14919. procedure SetMouse(mX,mY: integer);
  14920.     var arec: APPLRECORD;
  14921.  
  14922.     begin
  14923.         arec.Typ:=AT_MOUSE;
  14924.         arec.What.Hi:=mX;
  14925.         arec.What.Lo:=mY;
  14926.         appl_tplay(@arec,1,10000)
  14927.     end;
  14928.  
  14929.  
  14930. function IsMouseVisible: boolean;
  14931.  
  14932.     begin
  14933.         IsMouseVisible:=(mhstack<=0)
  14934.     end;
  14935.  
  14936.  
  14937. function IsMouseBusy: boolean;
  14938.  
  14939.     begin
  14940.         IsMouseBusy:=(mfstack>0)
  14941.     end;
  14942.  
  14943.  
  14944. procedure ShowMouse;
  14945.  
  14946.     begin
  14947.         gem.graf_mouse(M_ON,nil);
  14948.         dec(mhstack)
  14949.     end;
  14950.  
  14951.  
  14952. procedure HideMouse;
  14953.  
  14954.     begin
  14955.         gem.graf_mouse(M_OFF,nil);
  14956.         inc(mhstack)
  14957.     end;
  14958.  
  14959.  
  14960. procedure ArrowMouse;
  14961.  
  14962.     begin
  14963.         dec(mfstack);
  14964.         if mfstack<=0 then
  14965.             begin
  14966.                 graf_mouse(ARROW,nil);
  14967.                 mfstack:=0;
  14968.             end
  14969.     end;
  14970.  
  14971.  
  14972. procedure BusyMouse;
  14973.  
  14974.     begin
  14975.         graf_mouse(BUSYBEE,nil);
  14976.         inc(mfstack)
  14977.     end;
  14978.  
  14979.  
  14980. procedure SliceMouse;
  14981.  
  14982.     begin
  14983.         inc(mfstack);
  14984.         slmouse:=IDC_SLICE1;
  14985.         SliceMouseNext
  14986.     end;
  14987.  
  14988.  
  14989. procedure SliceMouseNext;
  14990.  
  14991.     begin
  14992.         if IsMouseBusy then
  14993.             begin
  14994.                 graf_mouse(slmouse,nil);
  14995.                 inc(slmouse);
  14996.                 if slmouse>IDC_SLICE4 then slmouse:=IDC_SLICE1
  14997.             end
  14998.     end;
  14999.  
  15000.  
  15001. procedure LastMouse;
  15002.  
  15003.     begin
  15004.         graf_mouse(mlnr,@mlform);
  15005.     end;
  15006.  
  15007.  
  15008. function HeapFunc(size: longint): integer;
  15009.  
  15010.   begin
  15011.       if Application<>nil then Application^.Err:=em_OutOfMemory;
  15012.     HeapFunc:=1
  15013.   end;
  15014.  
  15015.  
  15016. procedure SigHandler(dummy1,dummy2,sig: pointer);
  15017.  
  15018.     begin
  15019.         if Application<>nil then Application^.Status:=em_Terminate
  15020.     end;
  15021.  
  15022.  
  15023. procedure GOExit;
  15024.  
  15025.     begin
  15026.         ExitProc:=OldExit;
  15027.         if appdone and (Application<>nil) then Application^.Done
  15028.     end;
  15029.  
  15030.  
  15031. begin
  15032.     Application:=nil;
  15033.     appdone:=false;
  15034.     agi.ApplSearch:=false;
  15035.     profile:=nil;
  15036.     randomize;
  15037.     OldExit:=ExitProc;
  15038.     ExitProc:=@GOExit;
  15039.     HeapError:=@HeapFunc;
  15040.     slmouse:=IDC_SLICE1;
  15041.     mhstack:=0;
  15042.     mfstack:=0
  15043. end.